You've already forked lazarus-ccr
jvcllaz: Separation of designtime and runtime code and all packages complete. Use package names and location of the Delphi version (WILL BREAK EXISTING CODE). Update examples.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5436 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2344
components/jvcllaz/run/JvXPCtrls/JvXPBar.pas
Normal file
2344
components/jvcllaz/run/JvXPCtrls/JvXPBar.pas
Normal file
File diff suppressed because it is too large
Load Diff
980
components/jvcllaz/run/JvXPCtrls/JvXPButtons.pas
Normal file
980
components/jvcllaz/run/JvXPCtrls/JvXPButtons.pas
Normal file
@ -0,0 +1,980 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvXPButtons.PAS, released on 2004-01-01.
|
||||
|
||||
The Initial Developer of the Original Code is Marc Hoffman.
|
||||
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
|
||||
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.sourceforge.net
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id: JvXPButtons.pas 11167 2007-01-27 18:57:52Z obones $
|
||||
|
||||
{$MODE DELPHI}
|
||||
|
||||
unit JvXPButtons;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, TypInfo, LCLIntf, LCLType, LCLProc, LMessages, Graphics,
|
||||
Controls, Forms, ActnList, ImgList, Menus,
|
||||
JvXPCore, JvXPCoreUtils;
|
||||
|
||||
type
|
||||
TJvXPCustomButtonActionLink = class(TWinControlActionLink)
|
||||
protected
|
||||
function IsImageIndexLinked: Boolean; override;
|
||||
procedure AssignClient(AClient: TObject); override;
|
||||
procedure SetImageIndex(Value: Integer); override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TJvXPLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
|
||||
|
||||
TJvXPCustomButton = class(TJvXPCustomStyleControl)
|
||||
private
|
||||
FAutoGray: Boolean;
|
||||
FBgGradient: TBitmap;
|
||||
FCancel: Boolean;
|
||||
FCkGradient: TBitmap;
|
||||
FDefault: Boolean;
|
||||
FFcGradient: TBitmap;
|
||||
FGlyph: TPicture;
|
||||
FHlGradient: TBitmap;
|
||||
FImageChangeLink: TChangeLink;
|
||||
FImageIndex: Integer;
|
||||
FLayout: TJvXPLayout;
|
||||
FShowAccelChar: Boolean;
|
||||
FShowFocusRect: Boolean;
|
||||
FSmoothEdges: Boolean;
|
||||
FSpacing: Byte;
|
||||
FWordWrap: Boolean;
|
||||
procedure CMDialogKey(var Msg: TCMDialogKey); message CM_DIALOGKEY;
|
||||
procedure GlyphChange(Sender: TObject);
|
||||
procedure ImageListChange(Sender: TObject);
|
||||
protected
|
||||
function GetActionLinkClass: TControlActionLinkClass; override;
|
||||
function IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
|
||||
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
||||
procedure SetAutoGray(Value: Boolean); virtual;
|
||||
procedure SetDefault(Value: Boolean); virtual;
|
||||
procedure SetGlyph(Value: TPicture); virtual;
|
||||
procedure SetLayout(Value: TJvXPLayout); virtual;
|
||||
procedure SetShowAccelChar(Value: Boolean); virtual;
|
||||
procedure SetShowFocusRect(Value: Boolean); virtual;
|
||||
procedure SetSmoothEdges(Value: Boolean); virtual;
|
||||
procedure SetSpacing(Value: Byte); virtual;
|
||||
procedure SetWordWrap(Value: Boolean); virtual;
|
||||
procedure Paint; override;
|
||||
procedure HookResized; override;
|
||||
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
|
||||
procedure UpdateBitmaps;
|
||||
|
||||
// advanced properties.
|
||||
property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
|
||||
property Cancel: Boolean read FCancel write FCancel default False;
|
||||
property Default: Boolean read FDefault write SetDefault default False;
|
||||
property Glyph: TPicture read FGlyph write SetGlyph;
|
||||
property Layout: TJvXPLayout read FLayout write SetLayout default blGlyphLeft;
|
||||
property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
|
||||
property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default False;
|
||||
property SmoothEdges: Boolean read FSmoothEdges write SetSmoothEdges default True;
|
||||
property Spacing: Byte read FSpacing write SetSpacing default 3;
|
||||
property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Click; override;
|
||||
procedure Loaded ; override;
|
||||
published
|
||||
// property TabStop default True;
|
||||
// property UseDockManager default True;
|
||||
end;
|
||||
|
||||
TJvXPButton = class(TJvXPCustomButton)
|
||||
published
|
||||
// common properties.
|
||||
property Action;
|
||||
property Caption;
|
||||
property Enabled;
|
||||
property TabOrder;
|
||||
property TabStop default True;
|
||||
property Height default 21;
|
||||
property Width default 73;
|
||||
|
||||
// advanced properties.
|
||||
property AutoGray;
|
||||
property Cancel;
|
||||
property Default;
|
||||
property Glyph;
|
||||
property Layout;
|
||||
property ModalResult;
|
||||
property ShowAccelChar;
|
||||
property ShowFocusRect;
|
||||
property SmoothEdges;
|
||||
property Spacing;
|
||||
property WordWrap;
|
||||
|
||||
//property BevelInner;
|
||||
//property BevelOuter;
|
||||
//property BevelWidth;
|
||||
//property BiDiMode;
|
||||
//property Ctl3D;
|
||||
//property DockSite;
|
||||
//property ParentBiDiMode;
|
||||
//property ParentCtl3D;
|
||||
//property TabOrder;
|
||||
//property TabStop;
|
||||
property UseDockManager default True;
|
||||
property Align;
|
||||
property Anchors;
|
||||
//property AutoSize;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
// property OnCanResize;
|
||||
property DragMode;
|
||||
// property Enabled;
|
||||
property Font;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Style;
|
||||
property StyleManager;
|
||||
property Visible;
|
||||
//property OnDockDrop;
|
||||
//property OnDockOver;
|
||||
//property OnEndDock;
|
||||
//property OnGetSiteInfo;
|
||||
//property OnStartDock;
|
||||
//property OnUnDock;
|
||||
property OnClick;
|
||||
property OnConstrainedResize;
|
||||
property OnContextPopup;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
TJvXPToolType =
|
||||
(ttArrowLeft, ttArrowRight, ttClose, ttMaximize, ttMinimize, ttPopup, ttRestore, ttImage);
|
||||
|
||||
TJvXPCustomToolButton = class(TJvXPCustomStyleControl)
|
||||
private
|
||||
FToolType: TJvXPToolType;
|
||||
FDropDownMenu: TPopupMenu;
|
||||
FChangeLink: TChangeLink;
|
||||
FImages: TCustomImageList;
|
||||
FImageIndex: TImageIndex;
|
||||
procedure SetImages(const Value: TCustomImageList);
|
||||
procedure SetImageIndex(const Value: TImageIndex);
|
||||
procedure SetDropDownMenu(const Value: TPopupMenu);
|
||||
procedure DoImagesChange(Sender: TObject);
|
||||
protected
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X: Integer; Y: Integer); override;
|
||||
procedure SetToolType(Value: TJvXPToolType); virtual;
|
||||
procedure Paint; override;
|
||||
procedure HookResized; override;
|
||||
|
||||
property ToolType: TJvXPToolType read FToolType write SetToolType default ttClose;
|
||||
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
|
||||
property Images: TCustomImageList read FImages write SetImages;
|
||||
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TJvXPToolButton = class(TJvXPCustomToolButton)
|
||||
published
|
||||
property Enabled;
|
||||
property Color default clBlack;
|
||||
property Height default 15;
|
||||
property ToolType;
|
||||
property Width default 15;
|
||||
|
||||
//property BevelInner;
|
||||
//property BevelOuter;
|
||||
//property BevelWidth;
|
||||
//property BiDiMode;
|
||||
//property Ctl3D;
|
||||
//property DockSite;
|
||||
//property ParentBiDiMode;
|
||||
//property ParentCtl3D;
|
||||
//property TabOrder;
|
||||
//property TabStop;
|
||||
//property UseDockManager default True;
|
||||
property Align;
|
||||
property Anchors;
|
||||
//property AutoSize;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
//property OnCanResize;
|
||||
property DragMode;
|
||||
property DropDownMenu;
|
||||
property Images;
|
||||
property ImageIndex;
|
||||
|
||||
// property Enabled;
|
||||
property Font;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Style;
|
||||
property StyleManager;
|
||||
property Visible;
|
||||
//property OnDockDrop;
|
||||
//property OnDockOver;
|
||||
//property OnEndDock;
|
||||
//property OnGetSiteInfo;
|
||||
//property OnStartDock;
|
||||
//property OnUnDock;
|
||||
property OnClick;
|
||||
property OnConstrainedResize;
|
||||
property OnContextPopup;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
//{$R ../resource/JvXPCore.res}
|
||||
|
||||
//=== { TJvXPCustomButtonActionLink } ========================================
|
||||
|
||||
destructor TJvXPCustomButtonActionLink.Destroy;
|
||||
begin
|
||||
TJvXPCustomButton(FClient).Invalidate;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButtonActionLink.AssignClient(AClient: TObject);
|
||||
begin
|
||||
inherited AssignClient(AClient);
|
||||
FClient := AClient as TJvXPCustomButton;
|
||||
end;
|
||||
|
||||
function TJvXPCustomButtonActionLink.IsImageIndexLinked: Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButtonActionLink.SetImageIndex(Value: Integer);
|
||||
begin
|
||||
inherited SetImageIndex(Value);
|
||||
(FClient as TJvXPCustomButton).FImageIndex := Value;
|
||||
(FClient as TJvXPCustomButton).Invalidate;
|
||||
end;
|
||||
|
||||
//=== { TJvXPCustomButton } ==================================================
|
||||
|
||||
constructor TJvXPCustomButton.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
// create ...
|
||||
FBgGradient := TBitmap.Create; // background gradient
|
||||
FCkGradient := TBitmap.Create; // clicked gradient
|
||||
FFcGradient := TBitmap.Create; // focused gradient
|
||||
FHlGradient := TBitmap.Create; // Highlight gradient
|
||||
|
||||
// set default properties.
|
||||
ControlStyle := ControlStyle - [csDoubleClicks];
|
||||
Height := 21;
|
||||
Width := 73;
|
||||
TabStop := True;
|
||||
UseDockManager := true;
|
||||
|
||||
// set custom properties.
|
||||
FAutoGray := True;
|
||||
FCancel := False;
|
||||
FDefault := False;
|
||||
FImageIndex := -1;
|
||||
FImageChangeLink := TChangeLink.Create;
|
||||
FImageChangeLink.OnChange := ImageListChange;
|
||||
FGlyph := TPicture.Create;
|
||||
FGlyph.OnChange := GlyphChange;
|
||||
FLayout := blGlyphLeft;
|
||||
FShowAccelChar := True;
|
||||
FShowFocusRect := False;
|
||||
FSmoothEdges := True;
|
||||
FSpacing := 3;
|
||||
FWordWrap := True;
|
||||
end;
|
||||
|
||||
destructor TJvXPCustomButton.Destroy;
|
||||
begin
|
||||
FBgGradient.Free;
|
||||
FCkGradient.Free;
|
||||
FFcGradient.Free;
|
||||
FHlGradient.Free;
|
||||
FGlyph.Free;
|
||||
FImageChangeLink.OnChange := nil;
|
||||
FImageChangeLink.Free;
|
||||
FImageChangeLink := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.Click;
|
||||
begin
|
||||
// Only there to make it public (Mantis 4015)
|
||||
inherited Click;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
//HookResized;
|
||||
end;
|
||||
|
||||
function TJvXPCustomButton.GetActionLinkClass: TControlActionLinkClass;
|
||||
begin
|
||||
Result := TJvXPCustomButtonActionLink;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.CMDialogKey(var Msg: TCMDialogKey);
|
||||
begin
|
||||
inherited;
|
||||
with Msg do
|
||||
if (((CharCode = VK_RETURN) and (Focused or (FDefault and not (IsSibling)))) or
|
||||
((CharCode = VK_ESCAPE) and FCancel) and (KeyDataToShiftState(KeyData) = [])) and
|
||||
CanFocus then
|
||||
begin
|
||||
Click;
|
||||
Result := 1;
|
||||
end
|
||||
else
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetAutoGray(Value: Boolean);
|
||||
begin
|
||||
if Value <> FAutoGray then
|
||||
begin
|
||||
FAutoGray := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetDefault(Value: Boolean);
|
||||
begin
|
||||
if Value <> FDefault then
|
||||
begin
|
||||
FDefault := Value;
|
||||
if GetParentForm(Self) <> nil then
|
||||
with GetParentForm(Self) do
|
||||
Perform(CM_FOCUSCHANGED, 0, PtrInt(ActiveControl));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetGlyph(Value: TPicture);
|
||||
begin
|
||||
FGlyph.Assign(Value);
|
||||
LockedInvalidate;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetLayout(Value: TJvXPLayout);
|
||||
begin
|
||||
if Value <> FLayout then
|
||||
begin
|
||||
FLayout := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetShowAccelChar(Value: Boolean);
|
||||
begin
|
||||
if Value <> FShowAccelChar then
|
||||
begin
|
||||
FShowAccelChar := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetShowFocusRect(Value: Boolean);
|
||||
begin
|
||||
if Value <> FShowFocusRect then
|
||||
begin
|
||||
FShowFocusRect := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetSmoothEdges(Value: Boolean);
|
||||
begin
|
||||
if Value <> FSmoothEdges then
|
||||
begin
|
||||
FSmoothEdges := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetSpacing(Value: Byte);
|
||||
begin
|
||||
if Value <> FSpacing then
|
||||
begin
|
||||
FSpacing := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.SetWordWrap(Value: Boolean);
|
||||
begin
|
||||
if Value <> FWordWrap then
|
||||
begin
|
||||
FWordWrap := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.ImageListChange(Sender: TObject);
|
||||
begin
|
||||
if Assigned(Action) and (Sender is TCustomImageList) and
|
||||
Assigned(TAction(Action).ActionList.Images) and
|
||||
((TAction(Action).ImageIndex < (TAction(Action).ActionList.Images.Count))) then
|
||||
FImageIndex := TAction(Action).ImageIndex
|
||||
else
|
||||
FImageIndex := -1;
|
||||
LockedInvalidate;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.GlyphChange(Sender: TObject);
|
||||
begin
|
||||
LockedInvalidate;
|
||||
Paint;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if (Shift = []) and (Key = VK_SPACE) then
|
||||
begin
|
||||
DrawState := DrawState + [dsHighlight];
|
||||
HookMouseDown;
|
||||
end;
|
||||
inherited KeyDown(Key, Shift);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.KeyUp(var Key: Word; Shift: TShiftState);
|
||||
var
|
||||
Pos: TPoint;
|
||||
begin
|
||||
// it's not possible to call the 'HookMouseUp' or 'HookMouseLeave' methods,
|
||||
// because we don't want to call their event handlers.
|
||||
if dsClicked in DrawState then
|
||||
begin
|
||||
GetCursorPos(Pos);
|
||||
Pos := ScreenToClient(Pos);
|
||||
if not PtInRect(Bounds(0, 0, Width, Height), Pos) then
|
||||
DrawState := DrawState - [dsHighlight];
|
||||
DrawState := DrawState - [dsClicked];
|
||||
LockedInvalidate;
|
||||
Click;
|
||||
end;
|
||||
inherited KeyUp(Key, Shift);
|
||||
end;
|
||||
|
||||
function TJvXPCustomButton.IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
|
||||
begin
|
||||
if dsClicked in DrawState then
|
||||
Result := not (dsHighlight in DrawState)
|
||||
else
|
||||
Result := (dsHighlight in DrawState) or (dsFocused in DrawState);
|
||||
if not IgnoreDefault then
|
||||
Result := Result or (FDefault and CanFocus) and not IsSibling;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
||||
begin
|
||||
inherited ActionChange(Sender, CheckDefaults);
|
||||
if Sender is TCustomAction then
|
||||
with TCustomAction(Sender) do
|
||||
begin
|
||||
if Assigned(TCustomAction(Sender).ActionList.Images) and
|
||||
(FImageChangeLink.Sender <> TCustomAction(Sender).ActionList.Images) then
|
||||
TCustomAction(Sender).ActionList.Images.RegisterChanges(FImageChangeLink);
|
||||
if (ActionList <> nil) and (ActionList.Images <> nil) and
|
||||
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
|
||||
FImageIndex := ImageIndex;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.HookResized;
|
||||
begin
|
||||
inherited HookResized;
|
||||
UpdateBitmaps;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.UpdateBitmaps;
|
||||
const
|
||||
ColSteps = 64;
|
||||
Dithering = True;
|
||||
var
|
||||
Offset: Integer;
|
||||
begin
|
||||
// calculate offset
|
||||
Offset := 4 * (Integer(IsSpecialDrawState(True)));
|
||||
|
||||
// create gradient rectangles for...
|
||||
|
||||
// background
|
||||
if (Width - (2 + Offset) > 0) and (Height - (2 + Offset) > 0)
|
||||
then
|
||||
JvXPCreateGradientRect(Width - (2 + Offset), Height - (2 + Offset),
|
||||
dxColor_Btn_Enb_BgFrom_WXP, dxColor_Btn_Enb_BgTo_WXP, ColSteps, gsTop, Dithering,
|
||||
FBgGradient);
|
||||
|
||||
if (Width - 2 > 0) and (Height - 2 > 0) then
|
||||
begin
|
||||
// clicked
|
||||
JvXPCreateGradientRect(Width - 2, Height - 2, dxColor_Btn_Enb_CkFrom_WXP,
|
||||
dxColor_Btn_Enb_CkTo_WXP, ColSteps, gsTop, Dithering, FCkGradient);
|
||||
|
||||
// focused
|
||||
JvXPCreateGradientRect(Width - 2, Height - 2, dxColor_Btn_Enb_FcFrom_WXP,
|
||||
dxColor_Btn_Enb_FcTo_WXP, ColSteps, gsTop, Dithering, FFcGradient);
|
||||
|
||||
// highlight
|
||||
JvXPCreateGradientRect(Width - 2, Height - 2, dxColor_Btn_Enb_HlFrom_WXP,
|
||||
dxColor_Btn_Enb_HlTo_WXP, ColSteps, gsTop, Dithering, FHlGradient);
|
||||
end;
|
||||
{
|
||||
Invalidate;
|
||||
Paint;
|
||||
}
|
||||
end;
|
||||
|
||||
{
|
||||
procedure TJvXPCustomButton.HookResized;
|
||||
begin
|
||||
UpdateBitmaps;
|
||||
inherited;
|
||||
end;
|
||||
}
|
||||
|
||||
procedure TJvXPCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
|
||||
begin
|
||||
inherited;
|
||||
UpdateBitmaps;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomButton.Paint;
|
||||
var
|
||||
Rect: TRect;
|
||||
Offset, Flags: Integer;
|
||||
DrawPressed: Boolean;
|
||||
lImage: TPicture;
|
||||
lBitmap: TBitmap;
|
||||
begin
|
||||
with Canvas do
|
||||
begin
|
||||
// clear background.
|
||||
Rect := GetClientRect;
|
||||
Brush.Color := Self.Color;
|
||||
FillRect(Rect);
|
||||
|
||||
// draw gradient borders.
|
||||
if IsSpecialDrawState and
|
||||
( ((dsHighlight in DrawState) and (FHlGradient.Canvas.Handle <> 0)) or
|
||||
(not (dsHighlight in DrawState) and (FFcGradient.Canvas.Handle <> 0))
|
||||
)
|
||||
then begin
|
||||
lBitmap := TBitmap.Create;
|
||||
try
|
||||
if dsHighlight in DrawState then
|
||||
lBitmap.Assign(FHlGradient)
|
||||
else
|
||||
lBitmap.Assign(FFcGradient);
|
||||
BitBlt(Handle, 1, 1, Self.Width, Self.Height, lBitmap.Canvas.Handle, 0, 0, SRCCOPY);
|
||||
finally
|
||||
lBitmap.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
// draw background gradient...
|
||||
if not ((dsHighlight in DrawState) and (dsClicked in DrawState)) then
|
||||
begin
|
||||
if (FBgGradient.Canvas.Handle <> 0) Then
|
||||
begin
|
||||
Offset := 2 * Integer(IsSpecialDrawState);
|
||||
if (Self.Width - 3 * Offset > 1 + Offset) and
|
||||
(Self.Height - 3 * Offset > 1 + Offset)
|
||||
then
|
||||
BitBlt(Handle, 1 + Offset, 1 + Offset, self.Width - 3 * Offset, Self.Height - 3 * Offset,
|
||||
FBgGradient.Canvas.Handle, 0, 0, SRCCOPY);
|
||||
end;
|
||||
end
|
||||
// ...or click gradient.
|
||||
else
|
||||
if (FCkGradient.Canvas.Handle <> 0) then
|
||||
begin
|
||||
BitBlt(Handle, 1, 1, Self.Width, Self.Height, FCkGradient.Canvas.Handle, 0, 0, SRCCOPY);
|
||||
end;
|
||||
|
||||
// draw border lines.
|
||||
if Enabled then
|
||||
Pen.Color := dxColor_Btn_Enb_Border_WXP
|
||||
else
|
||||
Pen.Color := dxColor_Btn_Dis_Border_WXP;
|
||||
Brush.Style := bsClear;
|
||||
RoundRect(0, 0, Self.Width, Self.Height, 5, 5);
|
||||
|
||||
// draw border edges.
|
||||
if FSmoothEdges and (Self.Width > 2) and (Self.Height > 2) then
|
||||
begin
|
||||
if Enabled then
|
||||
Pen.Color := dxColor_Btn_Enb_Edges_WXP
|
||||
else
|
||||
Pen.Color := dxColor_Btn_Dis_Edges_WXP;
|
||||
JvXPDrawLine(Canvas, 0, 1, 2, 0);
|
||||
JvXPDrawLine(Canvas, Self.Width - 2, 0, Self.Width, 2);
|
||||
JvXPDrawLine(Canvas, 0, Self.Height - 2, 2, Self.Height);
|
||||
JvXPDrawLine(Canvas, Self.Width - 3, Self.Height, Self.Width, Self.Height - 3);
|
||||
end;
|
||||
|
||||
// set drawing flags.
|
||||
Flags := {DT_VCENTER or } DT_END_ELLIPSIS;
|
||||
if FWordWrap then
|
||||
Flags := Flags or DT_WORDBREAK;
|
||||
|
||||
// draw image & caption.
|
||||
lImage := TPicture.Create;
|
||||
try
|
||||
// get image from action or glyph property.
|
||||
if Assigned(Action) and Assigned(TAction(Action).ActionList.Images) and
|
||||
(FImageIndex > -1) and (FImageIndex < TAction(Action).ActionList.Images.Count)
|
||||
then
|
||||
TAction(Action).ActionList.Images.GetBitmap(FImageIndex, lImage.Bitmap)
|
||||
else
|
||||
lImage.Assign(FGlyph);
|
||||
|
||||
// autogray image (if allowed).
|
||||
if (lImage.Bitmap.Canvas.Handle <> 0) and FAutoGray and not Enabled then
|
||||
JvXPConvertToGray2(lImage.Bitmap);
|
||||
|
||||
// assign canvas font (change HotTrack-Color, if necessary).
|
||||
Font.Assign(Self.Font);
|
||||
|
||||
// calculate textrect.
|
||||
if Assigned(lImage.Graphic) and not lImage.Graphic.Empty then
|
||||
if Length(Caption) > 0 then
|
||||
begin
|
||||
case FLayout of
|
||||
blGlyphLeft:
|
||||
Inc(Rect.Left, lImage.Width + FSpacing);
|
||||
blGlyphRight:
|
||||
begin
|
||||
Dec(Rect.Left, lImage.Width + FSpacing);
|
||||
Dec(Rect.Right, (lImage.Width + FSpacing) * 2);
|
||||
Flags := Flags or DT_RIGHT;
|
||||
end;
|
||||
blGlyphTop:
|
||||
Inc(Rect.Top, lImage.Height + FSpacing);
|
||||
blGlyphBottom:
|
||||
Dec(Rect.Top, lImage.Height + FSpacing);
|
||||
end;
|
||||
end;
|
||||
|
||||
if Length(Caption) > 0 then
|
||||
begin
|
||||
JvXPRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, Rect, Flags or DT_CALCRECT);
|
||||
OffsetRect(Rect, (Self.Width - Rect.Right) div 2, (Self.Height - Rect.Bottom) div 2);
|
||||
end;
|
||||
|
||||
// should we draw the pressed state?
|
||||
DrawPressed := (dsHighlight in DrawState) and (dsClicked in DrawState);
|
||||
if DrawPressed then
|
||||
OffsetRect(Rect, 1, 1);
|
||||
|
||||
// draw image - if available.
|
||||
if Assigned(lImage.Graphic) and not lImage.Graphic.Empty then
|
||||
begin
|
||||
lImage.Graphic.Transparent := True;
|
||||
if Length(Caption) > 0 then
|
||||
case FLayout of
|
||||
blGlyphLeft:
|
||||
Draw(Rect.Left - (lImage.Width + FSpacing), (Self.Height - lImage.Height) div 2 +
|
||||
Integer(DrawPressed), lImage.Graphic);
|
||||
blGlyphRight:
|
||||
Draw(Rect.Right + FSpacing, (Self.Height - lImage.Height) div 2 +
|
||||
Integer(DrawPressed), lImage.Graphic);
|
||||
blGlyphTop:
|
||||
Draw((Self.Width - lImage.Width) div 2 + Integer(DrawPressed),
|
||||
Rect.Top - (lImage.Height + FSpacing), lImage.Graphic);
|
||||
blGlyphBottom:
|
||||
Draw((Self.Width - lImage.Width) div 2 + Integer(DrawPressed),
|
||||
Rect.Bottom + FSpacing, lImage.Graphic);
|
||||
end
|
||||
else
|
||||
// draw the glyph into the center
|
||||
Draw((Self.Width - lImage.Width) div 2 + Integer(DrawPressed),
|
||||
(Self.Height - lImage.Height) div 2 + Integer(DrawPressed), lImage.Graphic);
|
||||
end;
|
||||
|
||||
// draw focusrect (if enabled).
|
||||
if (dsFocused in DrawState) and FShowFocusRect then
|
||||
begin
|
||||
Brush.Style := bsSolid;
|
||||
DrawFocusRect(Bounds(3, 3, Self.Width - 6, Self.Height - 6));
|
||||
end;
|
||||
|
||||
// draw caption.
|
||||
SetBkMode(Handle, Transparent);
|
||||
JvXPRenderText(Self, Canvas, Caption, Font, Enabled, FShowAccelChar, Rect, Flags);
|
||||
SetBkMode(Handle, OPAQUE);
|
||||
finally
|
||||
lImage.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// TJvXPCustomToolButton =====================================================
|
||||
|
||||
constructor TJvXPCustomToolButton.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle - [csDoubleClicks];
|
||||
Color := clBlack;
|
||||
FToolType := ttClose;
|
||||
FChangeLink := TChangeLink.Create;
|
||||
FChangeLink.OnChange := DoImagesChange;
|
||||
HookResized;
|
||||
end;
|
||||
|
||||
destructor TJvXPCustomToolButton.Destroy;
|
||||
begin
|
||||
FChangeLink.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.HookResized;
|
||||
begin
|
||||
if ToolType <> ttImage then
|
||||
begin
|
||||
Height := 15;
|
||||
Width := 15;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.SetToolType(Value: TJvXPToolType);
|
||||
begin
|
||||
if Value <> FToolType then
|
||||
begin
|
||||
FToolType := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.Paint;
|
||||
var
|
||||
Rect: TRect;
|
||||
lBitmap: TBitmap;
|
||||
//Theme: TJvXPTheme;
|
||||
Shifted: Boolean;
|
||||
begin
|
||||
with Canvas do
|
||||
begin
|
||||
Rect := GetClientRect;
|
||||
Brush.Color := TJvXPWinControl(Parent).Color;
|
||||
Brush.Style := bsSolid;
|
||||
FillRect(Rect);
|
||||
if csDesigning in ComponentState then
|
||||
DrawFocusRect(Rect);
|
||||
Brush.Style := bsClear;
|
||||
{
|
||||
Theme := Style.GetTheme;
|
||||
if (Theme = WindowsXP) and (dsClicked in DrawState) and
|
||||
not (dsHighlight in DrawState)
|
||||
then
|
||||
JvXPFrame3d(Self.Canvas, Rect, clWhite, clBlack);
|
||||
}
|
||||
if dsHighlight in DrawState then
|
||||
begin
|
||||
{
|
||||
if Theme = WindowsXP then
|
||||
JvXPFrame3d(Self.Canvas, Rect, clWhite, clBlack, dsClicked in DrawState)
|
||||
else
|
||||
}
|
||||
begin
|
||||
Pen.Color := dxColor_BorderLineOXP;
|
||||
Rectangle(Rect);
|
||||
InflateRect(Rect, -1, -1);
|
||||
if dsClicked in DrawState then
|
||||
Brush.Color := dxColor_BgCkOXP
|
||||
else
|
||||
Brush.Color := dxColor_BgOXP;
|
||||
FillRect(Rect);
|
||||
end;
|
||||
end;
|
||||
// Shifted := (Theme = WindowsXP) and (dsClicked in DrawState); wp
|
||||
Shifted := dsClicked in DrawState;
|
||||
if ToolType = ttImage then
|
||||
begin
|
||||
if (Images = nil) or (ImageIndex < 0) or (ImageIndex >= Images.Count) then
|
||||
Exit;
|
||||
Images.Draw(Canvas,
|
||||
(Width - Images.Width) div 2 + Integer(Shifted),
|
||||
(Height - Images.Height) div 2 + Integer(Shifted),
|
||||
ImageIndex,
|
||||
{$IFDEF COMPILER6_UP}
|
||||
{$IFDEF VCL}
|
||||
dsTransparent,
|
||||
{$ENDIF VCL}
|
||||
itImage,
|
||||
{$ENDIF COMPILER6_UP}
|
||||
Enabled);
|
||||
end
|
||||
else
|
||||
begin
|
||||
lBitmap := TBitmap.Create;
|
||||
try
|
||||
{
|
||||
lBitmap.LoadFromLazarusResource(
|
||||
PChar('JvXPCustomToolButton' + Copy(GetEnumName(TypeInfo(TJvXPToolType),
|
||||
Ord(FToolType)), 3, MaxInt)));
|
||||
}
|
||||
lBitmap.Assign(nil); // fixes GDI resource leak
|
||||
lBitmap.LoadFromResourceName(HInstance,
|
||||
PChar('JvXPCustomToolButton' + Copy(GetEnumName(TypeInfo(TJvXPToolType),
|
||||
Ord(FToolType)), 3, MaxInt)));
|
||||
if (dsClicked in DrawState) and (dsHighlight in DrawState) then
|
||||
JvXPColorizeBitmap(lBitmap, clWhite)
|
||||
else
|
||||
if not Enabled then
|
||||
JvXPColorizeBitmap(lBitmap, clGray)
|
||||
else
|
||||
if Color <> clBlack then
|
||||
JvXPColorizeBitmap(lBitmap, Color);
|
||||
lBitmap.Transparent := True;
|
||||
Draw((ClientWidth - lBitmap.Width) div 2 + Integer(Shifted),
|
||||
(ClientHeight - lBitmap.Height) div 2 + Integer(Shifted), lBitmap);
|
||||
finally
|
||||
lBitmap.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if Operation = opRemove then
|
||||
begin
|
||||
if AComponent = DropDownMenu then
|
||||
DropDownMenu := nil
|
||||
else
|
||||
if AComponent = Images then
|
||||
Images := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.MouseDown(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Assigned(DropDownMenu) then
|
||||
begin
|
||||
P := ClientToScreen(Point(0, Height));
|
||||
DropDownMenu.Popup(P.X, P.Y);
|
||||
// while PeekMessage(Msg, HWND_DESKTOP, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
|
||||
{nothing};
|
||||
if GetCapture <> 0 then
|
||||
SendMessage(GetCapture, LM_CANCELMODE, 0, 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.SetImages(const Value: TCustomImageList);
|
||||
begin
|
||||
if FImages <> Value then
|
||||
begin
|
||||
if FImages <> nil then
|
||||
FImages.UnRegisterChanges(FChangeLink);
|
||||
FImages := Value;
|
||||
if FImages <> nil then
|
||||
begin
|
||||
FImages.FreeNotification(Self);
|
||||
FImages.RegisterChanges(FChangeLink);
|
||||
end;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.SetImageIndex(const Value: TImageIndex);
|
||||
begin
|
||||
if FImageIndex <> Value then
|
||||
begin
|
||||
FImageIndex := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.SetDropDownMenu(const Value: TPopupMenu);
|
||||
begin
|
||||
if FDropDownMenu <> Value then
|
||||
begin
|
||||
FDropDownMenu := Value;
|
||||
if FDropDownMenu <> nil then
|
||||
FDropDownMenu.FreeNotification(Self);
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.DoImagesChange(Sender: TObject);
|
||||
begin
|
||||
LockedInvalidate;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
456
components/jvcllaz/run/JvXPCtrls/JvXPCheckCtrls.pas
Normal file
456
components/jvcllaz/run/JvXPCtrls/JvXPCheckCtrls.pas
Normal file
@ -0,0 +1,456 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvXPCheckCtrls.PAS, released on 2004-01-01.
|
||||
|
||||
The Initial Developer of the Original Code is Marc Hoffman.
|
||||
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
|
||||
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
ZENSan : State and AllowGrayed properties
|
||||
Anudedeus (Alexandre Pranke) : State and AllowGrayed properties
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.sourceforge.net
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id: JvXPCheckCtrls.pas 11400 2007-06-28 21:24:06Z ahuser $
|
||||
|
||||
{$MODE DELPHI}
|
||||
|
||||
unit JvXPCheckCtrls;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, LCLIntf, LCLProc, LCLType, LResources, Graphics, Controls, StdCtrls,
|
||||
JvXPCore, JvXPCoreUtils;
|
||||
|
||||
type
|
||||
TJvXPCustomCheckControl = class(TJvXPCustomStyleControl)
|
||||
// TJvXPCustomCheckControl = class(TJvXPCustomControl)
|
||||
private
|
||||
FBgGradient: TBitmap;
|
||||
FBoundLines: TJvXPBoundLines;
|
||||
FChecked: Boolean;
|
||||
FCheckSize: Byte;
|
||||
FCkGradient: TBitmap;
|
||||
FHlGradient: TBitmap;
|
||||
FSpacing: Byte;
|
||||
FState: TCheckBoxState;
|
||||
FAllowGrayed: Boolean;
|
||||
procedure SetState(const Value: TCheckBoxState);
|
||||
procedure SetAllowGrayed(const Value: Boolean);
|
||||
protected
|
||||
procedure SetBoundLines(Value: TJvXPBoundLines); virtual;
|
||||
procedure SetChecked(Value: Boolean); virtual;
|
||||
procedure SetSpacing(Value: Byte); virtual;
|
||||
procedure DrawCheckSymbol(const R: TRect); virtual; abstract;
|
||||
procedure Click; override;
|
||||
procedure Paint; override;
|
||||
procedure HookResized; override;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
property BoundLines: TJvXPBoundLines read FBoundLines write SetBoundLines default [];
|
||||
property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed default False;
|
||||
property Checked: Boolean read FChecked write SetChecked default False;
|
||||
property Spacing: Byte read FSpacing write SetSpacing default 3;
|
||||
property State: TCheckBoxState read FState write SetState default cbUnchecked;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TJvXPCheckbox = class(TJvXPCustomCheckControl)
|
||||
protected
|
||||
procedure DrawCheckSymbol(const R: TRect); override;
|
||||
published
|
||||
// common properties.
|
||||
property Caption;
|
||||
property AllowGrayed;
|
||||
property Enabled;
|
||||
property TabOrder;
|
||||
property TabStop default True;
|
||||
// advanced properties.
|
||||
property BoundLines;
|
||||
property Checked;
|
||||
property Spacing;
|
||||
property ParentColor;
|
||||
property State;
|
||||
property Color;
|
||||
//property BevelInner;
|
||||
//property BevelOuter;
|
||||
//property BevelWidth;
|
||||
//property BiDiMode;
|
||||
//property Ctl3D;
|
||||
//property DockSite;
|
||||
//property ParentBiDiMode;
|
||||
//property ParentCtl3D;
|
||||
//property TabOrder;
|
||||
//property TabStop;
|
||||
//property UseDockManager default True;
|
||||
property Align;
|
||||
property Anchors;
|
||||
//property AutoSize;
|
||||
property Constraints;
|
||||
property BiDiMode;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
// property OnCanResize;
|
||||
property DragMode;
|
||||
//property Enabled;
|
||||
property Font;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Style;
|
||||
property StyleManager;
|
||||
property Visible;
|
||||
//property OnDockDrop;
|
||||
//property OnDockOver;
|
||||
//property OnEndDock;
|
||||
//property OnGetSiteInfo;
|
||||
//property OnStartDock;
|
||||
//property OnUnDock;
|
||||
property OnClick;
|
||||
property OnConstrainedResize;
|
||||
{$IFDEF COMPILER6_UP}
|
||||
property OnContextPopup;
|
||||
{$ENDIF COMPILER6_UP}
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ $R }
|
||||
//=== { TJvXPCustomCheckControl } ============================================
|
||||
|
||||
constructor TJvXPCustomCheckControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
// set default properties.
|
||||
ControlStyle := ControlStyle - [csDoubleClicks];
|
||||
Height := 17;
|
||||
TabStop := True;
|
||||
Width := 161;
|
||||
|
||||
// set custom properties.
|
||||
FBoundLines := [];
|
||||
FChecked := False;
|
||||
FCheckSize := 13;
|
||||
FSpacing := 3;
|
||||
|
||||
// create ...
|
||||
FBgGradient := TBitmap.Create; // background gradient
|
||||
FCkGradient := TBitmap.Create; // clicked gradient
|
||||
FHlGradient := TBitmap.Create; // Highlight gradient
|
||||
end;
|
||||
|
||||
destructor TJvXPCustomCheckControl.Destroy;
|
||||
begin
|
||||
FBgGradient.Free;
|
||||
FCkGradient.Free;
|
||||
FHlGradient.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.Click;
|
||||
begin
|
||||
if not AllowGrayed then
|
||||
Checked := not Checked
|
||||
else
|
||||
State := TCheckBoxState((Byte(State) + 1) mod 3);
|
||||
inherited Click;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.HookResized;
|
||||
begin
|
||||
// create gradient rectangles for...
|
||||
|
||||
// background.
|
||||
JvXPCreateGradientRect(FCheckSize - 2, FCheckSize - 2, dxColor_Btn_Enb_BgFrom_WXP,
|
||||
dxColor_Btn_Enb_BgTo_WXP, 16, gsTop, False, FBgGradient);
|
||||
|
||||
// clicked.
|
||||
JvXPCreateGradientRect(FCheckSize - 2, FCheckSize - 2, dxColor_Btn_Enb_CkFrom_WXP,
|
||||
dxColor_Btn_Enb_CkTo_WXP, 16, gsTop, True, FCkGradient);
|
||||
|
||||
// highlight.
|
||||
JvXPCreateGradientRect(FCheckSize - 2, FCheckSize - 2, dxColor_Btn_Enb_HlFrom_WXP,
|
||||
dxColor_Btn_Enb_HlTo_WXP, 16, gsTop, True, FHlGradient);
|
||||
|
||||
LockedInvalidate;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
case Key of
|
||||
VK_SPACE:
|
||||
Checked := not Checked;
|
||||
end;
|
||||
inherited KeyDown(Key, Shift);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.SetAllowGrayed(const Value: Boolean);
|
||||
begin
|
||||
FAllowGrayed := Value;
|
||||
if Value = False then
|
||||
if FState = cbGrayed then
|
||||
begin
|
||||
State := cbUnchecked;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.SetBoundLines(Value: TJvXPBoundLines);
|
||||
begin
|
||||
if Value <> FBoundLines then
|
||||
begin
|
||||
FBoundLines := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.SetChecked(Value: Boolean);
|
||||
begin
|
||||
if Value <> FChecked then
|
||||
begin
|
||||
FChecked := Value;
|
||||
if Value then
|
||||
FState := cbChecked
|
||||
else
|
||||
FState := cbUnchecked;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.SetSpacing(Value: Byte);
|
||||
begin
|
||||
if Value <> FSpacing then
|
||||
begin
|
||||
FSpacing := Value;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.SetState(const Value: TCheckBoxState);
|
||||
begin
|
||||
// will not change FState if FAllowGrayed = false and passed Value is cbGrayed
|
||||
if (FState <> Value) and (FAllowGrayed or (Value <> cbGrayed)) then
|
||||
begin
|
||||
FState := Value;
|
||||
if FState = cbChecked then
|
||||
FChecked := True
|
||||
else
|
||||
FChecked := False;
|
||||
LockedInvalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomCheckControl.Paint;
|
||||
var
|
||||
Rect: TRect;
|
||||
BoundColor: TColor;
|
||||
begin
|
||||
with Canvas do
|
||||
begin
|
||||
// clear background.
|
||||
Rect := GetClientRect;
|
||||
Brush.Color := Color;
|
||||
FillRect(Rect);
|
||||
// draw designtime rect.
|
||||
if csDesigning in ComponentState then
|
||||
DrawFocusRect(Rect);
|
||||
|
||||
// draw boundlines.
|
||||
if BoundLines <> [] then
|
||||
begin
|
||||
if Style.GetTheme = WindowsXP then
|
||||
BoundColor := dxColor_Btn_Enb_Border_WXP
|
||||
else
|
||||
BoundColor := dxColor_DotNetFrame;
|
||||
JvXPDrawBoundLines(Self.Canvas, BoundLines, BoundColor, Rect);
|
||||
end;
|
||||
|
||||
// draw focusrect.
|
||||
if dsFocused in DrawState then
|
||||
begin
|
||||
Brush.Style := bsSolid;
|
||||
DrawFocusRect(Rect);
|
||||
end;
|
||||
|
||||
// draw check symbol.
|
||||
DrawCheckSymbol(Rect);
|
||||
|
||||
// draw caption.
|
||||
SetBkMode(Handle, Transparent);
|
||||
Font.Assign(Self.Font);
|
||||
if BiDiMode = bdRightToLeft then
|
||||
begin
|
||||
Dec(Rect.Right, FCheckSize + 4 + Spacing);
|
||||
JvXPPlaceText(Self, Canvas, Caption, Font, Enabled, True, taRightJustify, True, Rect)
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(Rect.Left, FCheckSize + 4 + Spacing);
|
||||
JvXPPlaceText(Self, Canvas, Caption, Font, Enabled, True, taLeftJustify, True, Rect);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//=== { TJvXPCheckbox } ======================================================
|
||||
|
||||
procedure TJvXPCheckbox.DrawCheckSymbol(const R: TRect);
|
||||
var
|
||||
ClipW: Integer;
|
||||
Bitmap: TBitmap;
|
||||
Theme: TJvXPTheme;
|
||||
|
||||
procedure DrawGradient(const Bitmap: TBitmap);
|
||||
begin
|
||||
if BiDiMode = bdRightToLeft then
|
||||
BitBlt(Canvas.Handle, R.Right - 1 - FCheckSize, (ClientHeight - FCheckSize) div 2 + 1,
|
||||
FCheckSize - 2, FCheckSize - 2, Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
|
||||
else
|
||||
BitBlt(Canvas.Handle, R.Left + 3, (ClientHeight - FCheckSize) div 2 + 1,
|
||||
FCheckSize - 2, FCheckSize - 2, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
|
||||
end;
|
||||
|
||||
begin
|
||||
// get current theme.
|
||||
Theme := Style.GetTheme;
|
||||
|
||||
with Canvas do
|
||||
begin
|
||||
// check for highlight.
|
||||
ClipW := Ord(dsHighlight in DrawState);
|
||||
|
||||
// draw border.
|
||||
if (Theme = WindowsXP) or ((Theme = OfficeXP) and (ClipW = 0)) then
|
||||
Pen.Color := dxColor_Chk_Enb_Border_WXP
|
||||
else
|
||||
Pen.Color := dxColor_BorderLineOXP;
|
||||
if BiDiMode = bdRightToLeft then
|
||||
Rectangle(Bounds(R.Right - 2 - FCheckSize , (ClientHeight - FCheckSize) div 2,FCheckSize, FCheckSize))
|
||||
else
|
||||
Rectangle(Bounds(R.Left + 2, (ClientHeight - FCheckSize) div 2,FCheckSize, FCheckSize));
|
||||
|
||||
// draw background.
|
||||
case Theme of
|
||||
WindowsXP:
|
||||
begin
|
||||
if not ((ClipW <> 0) and (dsClicked in DrawState)) then
|
||||
begin
|
||||
if ClipW <> 0 then
|
||||
DrawGradient(FHlGradient);
|
||||
if BiDiMode = bdRightToLeft then
|
||||
BitBlt(Handle, R.Right - 1 - FCheckSize + ClipW, (ClientHeight - FCheckSize) div 2 + 1 +
|
||||
ClipW, FCheckSize - 2 - ClipW * 2, FCheckSize - 2 - ClipW * 2,
|
||||
FBgGradient.Canvas.Handle, 0, 0, SRCCOPY)
|
||||
else
|
||||
BitBlt(Handle, R.Left + 3 + ClipW, (ClientHeight - FCheckSize) div 2 + 1 +
|
||||
ClipW, FCheckSize - 2 - ClipW * 2, FCheckSize - 2 - ClipW * 2,
|
||||
FBgGradient.Canvas.Handle, 0, 0, SRCCOPY);
|
||||
end
|
||||
else
|
||||
DrawGradient(FCkGradient);
|
||||
end;
|
||||
OfficeXP:
|
||||
begin
|
||||
if ClipW <> 0 then
|
||||
begin
|
||||
if not (dsClicked in DrawState) then
|
||||
Brush.Color := dxColor_BgOXP
|
||||
else
|
||||
Brush.Color := dxColor_BgCkOXP;
|
||||
if BiDiMode = bdRightToLeft then
|
||||
FillRect(Bounds(R.Right - 1, (ClientHeight - FCheckSize) div 2 + 1,
|
||||
FCheckSize - 2, FCheckSize - 2))
|
||||
else
|
||||
FillRect(Bounds(R.Left + 3, (ClientHeight - FCheckSize) div 2 + 1,
|
||||
FCheckSize - 2, FCheckSize - 2))
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// draw checked or grayed symbols:
|
||||
if FState in [cbChecked, cbGrayed] then
|
||||
begin
|
||||
Brush.Color := clSilver;
|
||||
Pen.Color := dxColor_Btn_Enb_Border_WXP;
|
||||
Bitmap := TBitmap.Create;
|
||||
try
|
||||
Bitmap.Transparent := True;
|
||||
Bitmap.Assign(nil); // fixes GDI resource leak
|
||||
if FState = cbChecked then
|
||||
begin
|
||||
//Bitmap.LoadFromLazarusResource(HInstance, 'JvXPCheckboxCHECKBOX')
|
||||
Bitmap.LoadFromResourceName(HInstance, 'JvXPCheckboxCHECKBOX')
|
||||
end
|
||||
else
|
||||
begin
|
||||
Bitmap.Transparent := false;
|
||||
//Bitmap.LoadFromLazarusResource(HInstance, 'JvXPCheckboxCHECKBOXGRAY');
|
||||
Bitmap.LoadFromResourceName(HInstance, 'JvXPCheckboxCHECKBOXGRAY');
|
||||
end;
|
||||
if Theme = WindowsXP then
|
||||
begin
|
||||
if FState = cbChecked then
|
||||
JvXPColorizeBitmap(Bitmap, dxColor_Chk_Enb_NmSymb_WXP)
|
||||
else
|
||||
JvXPColorizeBitmap(Bitmap, dxColor_Chk_Enb_GraSymb_WXP);
|
||||
end
|
||||
else
|
||||
if (dsClicked in DrawState) and (dsHighlight in DrawState) then
|
||||
begin
|
||||
JvXPColorizeBitmap(Bitmap, clWhite);
|
||||
end;
|
||||
if BiDiMode = bdRightToLeft then
|
||||
Draw(R.Right - FCheckSize + 1, (ClientHeight - FCheckSize) div 2 + 3, Bitmap)
|
||||
else
|
||||
Draw(FCheckSize div 2 - 1, (ClientHeight - FCheckSize) div 2 + 3, Bitmap);
|
||||
finally
|
||||
Bitmap.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF USEJVCL}
|
||||
{$IFDEF UNITVERSIONING}
|
||||
initialization
|
||||
RegisterUnitVersion(HInstance, UnitVersioning);
|
||||
|
||||
finalization
|
||||
UnregisterUnitVersion(HInstance);
|
||||
{$ENDIF UNITVERSIONING}
|
||||
{$ENDIF USEJVCL}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
457
components/jvcllaz/run/JvXPCtrls/JvXPContainer.pas
Normal file
457
components/jvcllaz/run/JvXPCtrls/JvXPContainer.pas
Normal file
@ -0,0 +1,457 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvXPContainer.PAS, released on 2004-01-01.
|
||||
|
||||
The Initial Developer of the Original Code is Marc Hoffman.
|
||||
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
|
||||
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.sourceforge.net
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id: JvXPContainer.pas 11400 2007-06-28 21:24:06Z ahuser $
|
||||
|
||||
{ Ported to Lazarus by W.Pamler (2016-11-30) }
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
unit JvXPContainer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TypInfo, Classes, LCLIntf, LCLProc, LCLType, Controls, Graphics, StdCtrls, ExtCtrls,
|
||||
JvXPCore, JvXPCoreUtils;
|
||||
|
||||
type
|
||||
TJvXPPaintEvent = procedure(Sender: TObject; Rect: TRect; ACanvas: TCanvas;
|
||||
AFont: TFont) of object;
|
||||
|
||||
TJvXPEnabledMode = (emAffectChilds, emNormal);
|
||||
|
||||
TJvXPCustomContainer = class(TJvXPCustomControl)
|
||||
private
|
||||
FAlignment: TAlignment;
|
||||
FBorderWidth: TBorderWidth;
|
||||
FBoundColor: TColor;
|
||||
FBoundLines: TJvXPBoundLines;
|
||||
FEnabledMode: TJvXPEnabledMode;
|
||||
FFocusable: Boolean;
|
||||
FGlyph: TBitmap;
|
||||
FGlyphLayout: TJvXPGlyphLayout;
|
||||
FLayout: TTextLayout;
|
||||
FShowBoundLines: Boolean;
|
||||
FShowCaption: Boolean;
|
||||
FSpacing: Byte;
|
||||
FWordWrap: Boolean;
|
||||
FOnEnabledChanged: TNotifyEvent;
|
||||
FOnPaint: TJvXPPaintEvent;
|
||||
procedure SetAlignment(Value: TAlignment);
|
||||
procedure SetBorderWidth(Value: TBorderWidth);
|
||||
procedure SetBoundColor(Value: TColor);
|
||||
procedure SetBoundLines(Value: TJvXPBoundLines);
|
||||
procedure SetEnabledMode(Value: TJvXPEnabledMode);
|
||||
procedure SetGlyph(Value: TBitmap);
|
||||
procedure SetGlyphLayout(Value: TJvXPGlyphLayout);
|
||||
procedure SetLayout(Value: TTextLayout);
|
||||
procedure SetShowBoundLines(Value: Boolean);
|
||||
procedure SetShowCaption(Value: Boolean);
|
||||
procedure SetSpacing(Value: Byte);
|
||||
procedure SetWordWrap(Value: Boolean);
|
||||
protected
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
procedure AdjustClientRect(var Rect: TRect); override;
|
||||
procedure HookEnabledChanged; override;
|
||||
procedure HookMouseDown; override;
|
||||
procedure HookPosChanged; override;
|
||||
procedure Paint; override;
|
||||
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
||||
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
|
||||
property BoundColor: TColor read FBoundColor write SetBoundColor default clGray;
|
||||
property BoundLines: TJvXPBoundLines read FBoundLines write SetBoundLines default [];
|
||||
property EnabledMode: TJvXPEnabledMode read FEnabledMode write SetEnabledMode default emNormal;
|
||||
property Focusable: Boolean read FFocusable write FFocusable default False;
|
||||
property Glyph: TBitmap read FGlyph write SetGlyph;
|
||||
property GlyphLayout: TJvXPGlyphLayout read FGlyphLayout write SetGlyphLayout
|
||||
default glCenter;
|
||||
property Layout: TTextLayout read FLayout write SetLayout default tlCenter;
|
||||
property Height default 41;
|
||||
property ShowBoundLines: Boolean read FShowBoundLines write SetShowBoundLines
|
||||
default True;
|
||||
property ShowCaption: Boolean read FShowCaption write SetShowCaption
|
||||
default False;
|
||||
property Spacing: Byte read FSpacing write SetSpacing default 5;
|
||||
property Width default 185;
|
||||
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
|
||||
property OnEnabledChanged: TNotifyEvent read FOnEnabledChanged write FOnEnabledChanged;
|
||||
property OnPaint: TJvXPPaintEvent read FOnPaint write FOnPaint;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TJvXPContainer = class(TJvXPCustomContainer)
|
||||
published
|
||||
property Alignment;
|
||||
property AutoSize;
|
||||
property BorderWidth;
|
||||
property BoundColor;
|
||||
property BoundLines;
|
||||
property Caption;
|
||||
property Color;
|
||||
property Enabled;
|
||||
property EnabledMode;
|
||||
property Focusable;
|
||||
property Glyph;
|
||||
property GlyphLayout;
|
||||
property Layout;
|
||||
property ParentColor;
|
||||
property ShowBoundLines;
|
||||
property ShowCaption;
|
||||
property Spacing;
|
||||
property WordWrap;
|
||||
property OnEnabledChanged;
|
||||
property OnDblClick;
|
||||
property OnPaint;
|
||||
property OnResize;
|
||||
|
||||
//property BevelInner;
|
||||
//property BevelOuter;
|
||||
//property BevelWidth;
|
||||
//property BiDiMode;
|
||||
//property Ctl3D;
|
||||
//property DockSite;
|
||||
//property ParentBiDiMode;
|
||||
//property ParentCtl3D;
|
||||
//property TabOrder;
|
||||
//property TabStop;
|
||||
//property UseDockManager default True;
|
||||
property Align;
|
||||
property Anchors;
|
||||
//property AutoSize;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
// property OnCanResize; -- wp
|
||||
property DragMode;
|
||||
//property Enabled;
|
||||
property Font;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
//property OnDockDrop;
|
||||
//property OnDockOver;
|
||||
//property OnEndDock;
|
||||
//property OnGetSiteInfo;
|
||||
//property OnStartDock;
|
||||
//property OnUnDock;
|
||||
property OnClick;
|
||||
property OnConstrainedResize;
|
||||
property OnContextPopup;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
//=== { TJvXPCustomContainer } ===============================================
|
||||
|
||||
constructor TJvXPCustomContainer.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csAcceptsControls];
|
||||
Height := 41;
|
||||
Width := 185;
|
||||
FAlignment := taCenter;
|
||||
FBoundColor := clGray;
|
||||
FBoundLines := [];
|
||||
FEnabledMode := emNormal;
|
||||
FFocusable := False;
|
||||
FGlyph := TBitmap.Create;
|
||||
FGlyph.Assign(nil);
|
||||
FGlyphLayout := glCenter;
|
||||
FLayout := tlCenter;
|
||||
FShowBoundLines := True;
|
||||
FShowCaption := False;
|
||||
FSpacing := 5;
|
||||
FWordWrap := False;
|
||||
end;
|
||||
|
||||
destructor TJvXPCustomContainer.Destroy;
|
||||
begin
|
||||
FGlyph.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
procedure TJvXPCustomContainer.CreateParams(var Params: TCreateParams);
|
||||
begin
|
||||
inherited CreateParams(Params);
|
||||
with Params do
|
||||
WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
|
||||
end;
|
||||
|
||||
|
||||
procedure TJvXPCustomContainer.HookEnabledChanged;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
inherited HookEnabledChanged;
|
||||
if FEnabledMode = emAffectChilds then
|
||||
for I := 0 to ControlCount - 1 do
|
||||
Controls[I].Enabled := Enabled;
|
||||
if Assigned(FOnEnabledChanged) then
|
||||
FOnEnabledChanged(Self);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.HookMouseDown;
|
||||
begin
|
||||
if FFocusable then
|
||||
inherited HookMouseDown
|
||||
else
|
||||
begin
|
||||
DrawState := DrawState + [dsClicked];
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.HookPosChanged;
|
||||
begin
|
||||
inherited HookPosChanged;
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.AdjustClientRect(var Rect: TRect);
|
||||
begin
|
||||
inherited AdjustClientRect(Rect);
|
||||
JvXPAdjustBoundRect(BorderWidth, FShowBoundLines, FBoundLines, Rect);
|
||||
if not FGlyph.Empty then
|
||||
Inc(Rect.Left, FGlyph.Width);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetAlignment(Value: TAlignment);
|
||||
begin
|
||||
if Value <> FAlignment then
|
||||
begin
|
||||
FAlignment := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetBoundColor(Value: TColor);
|
||||
begin
|
||||
if Value <> FBoundColor then
|
||||
begin
|
||||
FBoundColor := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetBoundLines(Value: TJvXPBoundLines);
|
||||
begin
|
||||
if Value <> FBoundLines then
|
||||
begin
|
||||
FBoundLines := Value;
|
||||
Realign;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetBorderWidth(Value: TBorderWidth);
|
||||
begin
|
||||
if Value <> FBorderWidth then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Realign;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetEnabledMode(Value: TJvXPEnabledMode);
|
||||
begin
|
||||
if Value <> FEnabledMode then
|
||||
begin
|
||||
FEnabledMode := Value;
|
||||
HookEnabledChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetGlyph(Value: TBitmap);
|
||||
begin
|
||||
if Value <> FGlyph then
|
||||
begin
|
||||
FGlyph.Assign(Value);
|
||||
Realign;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetGlyphLayout(Value: TJvXPGlyphLayout);
|
||||
begin
|
||||
if FGlyphLayout <> Value then
|
||||
begin
|
||||
FGlyphLayout := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetLayout(Value: TTextLayout);
|
||||
begin
|
||||
if FLayout <> Value then
|
||||
begin
|
||||
FLayout := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetShowBoundLines(Value: Boolean);
|
||||
begin
|
||||
if Value <> FShowBoundLines then
|
||||
begin
|
||||
FShowBoundLines := Value;
|
||||
Realign;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetShowCaption(Value: Boolean);
|
||||
begin
|
||||
if Value <> FShowCaption then
|
||||
begin
|
||||
FShowCaption := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetSpacing(Value: Byte);
|
||||
begin
|
||||
if Value <> FSpacing then
|
||||
begin
|
||||
FSpacing := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetWordWrap(Value: Boolean);
|
||||
begin
|
||||
if Value <> FWordWrap then
|
||||
begin
|
||||
FWordWrap := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DxDrawText(AParent: TJvXPCustomControl; ACaption: TCaption; AFont: TFont;
|
||||
AAlignment: TAlignment; ALayout: TTextLayout; AWordWrap: Boolean; var ARect: TRect);
|
||||
const
|
||||
Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
||||
WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);
|
||||
var
|
||||
DrawStyle: Longint;
|
||||
CalcRect: TRect;
|
||||
|
||||
procedure DoDrawText(ACanvas: TCanvas; const ACaption: TCaption; var ARect: TRect;
|
||||
AFlags: Integer);
|
||||
begin
|
||||
// (rom) Kludge! This will probably not work for CLX
|
||||
DrawText(ACanvas.Handle, PChar(ACaption), -1, ARect, AFlags);
|
||||
end;
|
||||
|
||||
begin
|
||||
with AParent, Canvas do
|
||||
begin
|
||||
DrawStyle := Alignments[AAlignment];
|
||||
if (DrawStyle <> DT_LEFT) and (ARect.Right - ARect.Left < TextWidth(ACaption)) then
|
||||
DrawStyle := DT_LEFT;
|
||||
DrawStyle := DrawStyle or DT_EXPANDTABS or WordWraps[AWordWrap] or DT_END_ELLIPSIS;
|
||||
if ALayout <> tlTop then
|
||||
begin
|
||||
CalcRect := ARect;
|
||||
DoDrawText(Canvas, ACaption, CalcRect, DrawStyle or DT_CALCRECT);
|
||||
if ALayout = tlBottom then
|
||||
OffsetRect(ARect, 0, ARect.Bottom - CalcRect.Bottom)
|
||||
else
|
||||
OffsetRect(ARect, 0, (ARect.Bottom - CalcRect.Bottom) div 2);
|
||||
end;
|
||||
DoDrawText(Canvas, ACaption, ARect, DrawStyle);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.Paint;
|
||||
var
|
||||
Rect: TRect;
|
||||
begin
|
||||
with Canvas do
|
||||
begin
|
||||
Rect := GetClientRect;
|
||||
Brush.Color := Self.Color;
|
||||
FillRect(Rect);
|
||||
if csDesigning in ComponentState then
|
||||
DrawFocusRect(Rect);
|
||||
Brush.Style := bsClear;
|
||||
if (FShowBoundLines) and (FBoundLines <> []) then
|
||||
JvXPDrawBoundLines(Self.Canvas, FBoundLines, FBoundColor, Rect);
|
||||
JvXPAdjustBoundRect(BorderWidth, FShowBoundLines, FBoundLines, Rect);
|
||||
if Assigned(FOnPaint) then
|
||||
FOnPaint(Self, Rect, Self.Canvas, Font);
|
||||
if not FGlyph.Empty then
|
||||
begin
|
||||
FGlyph.Transparent := True;
|
||||
if FGlyphLayout = glBottom then
|
||||
Draw(Rect.Left, Rect.Bottom - FGlyph.Height, FGlyph);
|
||||
if FGlyphLayout = glCenter then
|
||||
Draw(Rect.Left, ((Rect.Bottom - Rect.Top) - FGlyph.Height) div 2 + 1, FGlyph);
|
||||
if FGlyphLayout = glTop then
|
||||
Draw(Rect.Left, Rect.Top, FGlyph);
|
||||
Inc(Rect.Left, FGlyph.Width);
|
||||
end;
|
||||
if FShowCaption then
|
||||
begin
|
||||
Font.Assign(Self.Font);
|
||||
InflateRect(Rect, -FSpacing, -1);
|
||||
if csDesigning in ComponentState then
|
||||
begin
|
||||
Pen.Color := clGray;
|
||||
Pen.Style := psSolid;
|
||||
MoveTo(Rect.Left, Rect.Top);
|
||||
LineTo(Rect.Left, Rect.Bottom);
|
||||
MoveTo(Rect.Right, Rect.Top);
|
||||
LineTo(Rect.Right, Rect.Bottom);
|
||||
end;
|
||||
DxDrawText(Self, Caption, Font, FAlignment, FLayout, FWordWrap, Rect);
|
||||
//JvXPPlaceText(Self, Canvas, Caption, Font, Enabled, False, FAlignment,
|
||||
// FWordWrap, Rect);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
910
components/jvcllaz/run/JvXPCtrls/JvXPCore.pas
Normal file
910
components/jvcllaz/run/JvXPCtrls/JvXPCore.pas
Normal file
@ -0,0 +1,910 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvXPCore.PAS, released on 2004-01-01.
|
||||
|
||||
The Initial Developer of the Original Code is Marc Hoffman.
|
||||
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
|
||||
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.sourceforge.net
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id: JvXPCore.pas 11400 2007-06-28 21:24:06Z ahuser $
|
||||
|
||||
// Ported to Lazarus (no too hard after all) by Sergio Samayoa - september 2007.
|
||||
// Still dont tested on linux.
|
||||
|
||||
unit JvXPCore;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Controls, Forms, Graphics, JvComponent, LCLIntf, LCLType, LMessages;
|
||||
|
||||
const
|
||||
{ color constants.
|
||||
|
||||
these constants are used as default colors for descendant controls
|
||||
and may be replaced with other (common) values.
|
||||
|
||||
syntax: JvXPColor_[Control]_[Enabled: Enb, Dis]_[Type]_[Theme: WXP, OXP] }
|
||||
|
||||
{ button colors - WindowsXP }
|
||||
dxColor_Btn_Enb_Border_WXP = TColor($00733800); // border line
|
||||
dxColor_Btn_Dis_Border_WXP = TColor($00BDC7CE); // border line (disabled)
|
||||
dxColor_Btn_Enb_Edges_WXP = TColor($00AD9E7B); // border edges
|
||||
dxColor_Btn_Dis_Edges_WXP = TColor($00BDC7CE); // border edges (disabled)
|
||||
dxColor_Btn_Enb_BgFrom_WXP = TColor($00FFFFFF); // background from
|
||||
dxColor_Btn_Enb_BgTo_WXP = TColor($00E7EBEF); // background to
|
||||
dxColor_Btn_Enb_CkFrom_WXP = TColor($00C6CFD6); // clicked from
|
||||
dxColor_Btn_Enb_CkTo_WXP = TColor($00EBF3F7); // clicked to
|
||||
dxColor_Btn_Enb_FcFrom_WXP = TColor($00FFE7CE); // focused from
|
||||
dxColor_Btn_Enb_FcTo_WXP = TColor($00EF846D); // focused to
|
||||
dxColor_Btn_Enb_HlFrom_WXP = TColor($00CEF3FF); // highlight from
|
||||
dxColor_Btn_Enb_HlTo_WXP = TColor($000096E7); // highlight to
|
||||
|
||||
{ checkbox colors - WindowsXP }
|
||||
dxColor_Chk_Enb_Border_WXP = TColor($00845118); // border line
|
||||
dxColor_Chk_Enb_NmSymb_WXP = TColor($0021A621); // symbol normal
|
||||
dxColor_Chk_Enb_GraSymb_WXP = TColor($0071C671); // symbol grayed
|
||||
|
||||
{ misc colors - WindowsXP }
|
||||
dxColor_Msc_Dis_Caption_WXP = TColor($0094A6A5); // caption color (disabled)
|
||||
|
||||
dxColor_DotNetFrame = TColor($00F7FBFF); // $00E7EBEF;
|
||||
dxColor_BorderLineOXP = TColor($00663300);
|
||||
dxColor_BgOXP = TColor($00D6BEB5);
|
||||
dxColor_BgCkOXP = TColor($00CC9999);
|
||||
|
||||
type
|
||||
TJvXPCustomStyleControl = class;
|
||||
|
||||
TJvXPBoundLines = set of (
|
||||
blLeft, // left line
|
||||
blTop, // top line
|
||||
blRight, // right line
|
||||
blBottom // bottom line
|
||||
);
|
||||
|
||||
TJvXPControlStyle = set of (
|
||||
csRedrawCaptionChanged, // (default)
|
||||
csRedrawBorderChanged, //
|
||||
csRedrawEnabledChanged, // (default)
|
||||
csRedrawFocusedChanged, // (default)
|
||||
csRedrawMouseDown, // (default)
|
||||
csRedrawMouseEnter, // (default)
|
||||
csRedrawMouseLeave, // (default)
|
||||
csRedrawMouseMove, //
|
||||
csRedrawMouseUp, // (default)
|
||||
csRedrawParentColorChanged, // (default)
|
||||
csRedrawParentFontChanged, //
|
||||
csRedrawPosChanged, //
|
||||
csRedrawResized //
|
||||
);
|
||||
|
||||
TJvXPDrawState = set of (
|
||||
dsDefault, // default
|
||||
dsHighlight, // highlighted
|
||||
dsClicked, // clicked
|
||||
dsFocused); // focused
|
||||
|
||||
TJvXPGlyphLayout = (
|
||||
glBottom, // bottom glyph
|
||||
glCenter, // centered glyph
|
||||
glTop); // top glyph
|
||||
|
||||
TJvXPTheme = (
|
||||
WindowsXP, // WindowsXP theme
|
||||
OfficeXP); // OfficeXP theme
|
||||
|
||||
{ baseclass for non-focusable component descendants. }
|
||||
TJvXPCustomComponent = class(TComponent)
|
||||
(******************** NOT CONVERTED
|
||||
private
|
||||
FVersion: string;
|
||||
procedure SetVersion(const Value: string);
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
published
|
||||
property Version: string read FVersion write SetVersion stored False;
|
||||
******************** NOT CONVERTED *)
|
||||
end;
|
||||
|
||||
type
|
||||
TJvXPWinControl = class(TWinControl)
|
||||
published
|
||||
property Color;
|
||||
end;
|
||||
|
||||
{ baseclass for focusable control descendants. }
|
||||
|
||||
TJvXPCustomControl = class(TCustomControl) //(TJvCustomControl)
|
||||
// TJvXPCustomControl = class(TJvCustomControl)
|
||||
private
|
||||
FClicking: Boolean;
|
||||
FDrawState: TJvXPDrawState;
|
||||
FIsLocked: Boolean;
|
||||
FIsSibling: Boolean;
|
||||
FModalResult: TModalResult;
|
||||
FOnMouseLeave: TNotifyEvent;
|
||||
FOnMouseEnter: TNotifyEvent;
|
||||
procedure SetVersion(const Value: string);
|
||||
procedure CMFocusChanged(var Msg: TLMessage); message CM_FOCUSCHANGED;
|
||||
procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
|
||||
procedure CMBorderChanged(var Msg: TLMessage); message CM_BORDERCHANGED;
|
||||
procedure CMEnabledChanged(var Msg: TLMessage); message CM_ENABLEDCHANGED;
|
||||
procedure CMMouseEnter(var Msg: TLMessage); message CM_MOUSEENTER;
|
||||
procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE;
|
||||
procedure CMParentColorChanged(var Msg: TLMessage); message CM_PARENTCOLORCHANGED;
|
||||
procedure CMParentFontChanged(var Msg: TLMessage); message CM_PARENTFONTCHANGED;
|
||||
|
||||
//LCL doesnt fire it
|
||||
//procedure CMParentFontChanged(var Msg: TLMessage); message CM_PARENTFONTCHANGED;
|
||||
|
||||
//procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED;
|
||||
procedure WMMouseMove(var Msg: TLMMouse); message LM_MOUSEMOVE;
|
||||
procedure WMSize(var Msg: TLMSize); message LM_SIZE;
|
||||
procedure WMWindowPosChanged(var Msg: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
|
||||
|
||||
protected
|
||||
ExControlStyle: TJvXPControlStyle;
|
||||
procedure InternalRedraw; dynamic;
|
||||
procedure HookBorderChanged; dynamic;
|
||||
procedure HookEnabledChanged; dynamic;
|
||||
procedure HookFocusedChanged; dynamic;
|
||||
procedure HookMouseDown; dynamic;
|
||||
procedure HookMouseEnter; dynamic;
|
||||
procedure HookMouseLeave; dynamic;
|
||||
procedure HookMouseMove(X: Integer = 0; Y: Integer = 0); dynamic;
|
||||
procedure HookMouseUp; dynamic;
|
||||
procedure HookParentColorChanged; dynamic;
|
||||
procedure HookParentFontChanged; dynamic;
|
||||
procedure HookPosChanged; dynamic;
|
||||
procedure HookResized; dynamic;
|
||||
procedure HookTextChanged; dynamic;
|
||||
procedure BeginUpdate; dynamic;
|
||||
procedure EndUpdate; dynamic;
|
||||
procedure LockedInvalidate; dynamic;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure Click; override;
|
||||
procedure Resize; override;
|
||||
procedure TextChanged; override;
|
||||
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
|
||||
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
||||
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
property Canvas;
|
||||
property DrawState: TJvXPDrawState read FDrawState write FDrawState;
|
||||
property IsLocked: Boolean read FIsLocked write FIsLocked;
|
||||
property IsSibling: Boolean read FIsSibling write FIsSibling;
|
||||
end;
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
TJvXPUnlimitedControl = class(TJvXPCustomControl)
|
||||
published
|
||||
//property BevelInner;
|
||||
//property BevelOuter;
|
||||
//property BevelWidth;
|
||||
//property BiDiMode;
|
||||
//property Ctl3D;
|
||||
//property DockSite;
|
||||
//property ParentBiDiMode;
|
||||
//property ParentCtl3D;
|
||||
//property TabOrder;
|
||||
//property TabStop;
|
||||
//property UseDockManager default True;
|
||||
property Align;
|
||||
property Anchors;
|
||||
//property AutoSize;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property OnCanResize;
|
||||
property DragMode;
|
||||
//property Enabled;
|
||||
property Font;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
//property OnDockDrop;
|
||||
//property OnDockOver;
|
||||
//property OnEndDock;
|
||||
//property OnGetSiteInfo;
|
||||
//property OnStartDock;
|
||||
//property OnUnDock;
|
||||
property OnClick;
|
||||
property OnConstrainedResize;
|
||||
property OnContextPopup;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
******************** NOT CONVERTED *)
|
||||
|
||||
TJvXPStyle = class(TPersistent)
|
||||
private
|
||||
FTheme: TJvXPTheme;
|
||||
FUseStyleManager: Boolean;
|
||||
protected
|
||||
Parent: TJvXPCustomStyleControl;
|
||||
procedure SetTheme(Value: TJvXPTheme); virtual;
|
||||
procedure SetUseStyleManager(Value: Boolean); virtual;
|
||||
public
|
||||
constructor Create(AOwner: TComponent);
|
||||
function GetTheme: TJvXPTheme;
|
||||
published
|
||||
property Theme: TJvXPTheme read FTheme write SetTheme default WindowsXP;
|
||||
property UseStyleManager: Boolean read FUseStyleManager write SetUseStyleManager default True;
|
||||
end;
|
||||
|
||||
TJvXPStyleManager = class(TJvXPCustomComponent)
|
||||
private
|
||||
FControls: TList;
|
||||
FTheme: TJvXPTheme;
|
||||
FOnThemeChanged: TNotifyEvent;
|
||||
procedure InvalidateControls;
|
||||
protected
|
||||
procedure FreeNotifyControls;
|
||||
procedure SetTheme(Value: TJvXPTheme); virtual;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure RegisterControls(const AControls: array of TJvXPCustomControl);
|
||||
procedure UnregisterControls(const AControls: array of TJvXPCustomControl);
|
||||
published
|
||||
property Theme: TJvXPTheme read FTheme write SetTheme default WindowsXP;
|
||||
property OnThemeChanged: TNotifyEvent read FOnThemeChanged write FOnThemeChanged;
|
||||
end;
|
||||
|
||||
TJvXPCustomStyleControl = class(TJvXPCustomControl)
|
||||
private
|
||||
FStyle: TJvXPStyle;
|
||||
FStyleManager: TJvXPStyleManager;
|
||||
protected
|
||||
procedure SetStyleManager(Value: TJvXPStyleManager); virtual;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
property Style: TJvXPStyle read FStyle write FStyle;
|
||||
property StyleManager: TJvXPStyleManager read FStyleManager write SetStyleManager;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TJvXPGradientColors = 2..255;
|
||||
|
||||
TJvXPGradientStyle = (gsLeft, gsTop, gsRight, gsBottom);
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
TJvXPGradient = class(TPersistent)
|
||||
private
|
||||
FColors: TJvXPGradientColors;
|
||||
FDithered: Boolean;
|
||||
FEnabled: Boolean;
|
||||
FEndColor: TColor;
|
||||
FStartColor: TColor;
|
||||
FGradientStyle: TJvXPGradientStyle;
|
||||
protected
|
||||
Parent: TJvXPCustomControl;
|
||||
procedure SetDithered(Value: Boolean); virtual;
|
||||
procedure SetColors(Value: TJvXPGradientColors); virtual;
|
||||
procedure SetEnabled(Value: Boolean); virtual;
|
||||
procedure SetEndColor(Value: TColor); virtual;
|
||||
procedure SetGradientStyle(Value: TJvXPGradientStyle); virtual;
|
||||
procedure SetStartColor(Value: TColor); virtual;
|
||||
public
|
||||
Bitmap: TBitmap;
|
||||
constructor Create(AOwner: TControl);
|
||||
destructor Destroy; override;
|
||||
procedure RecreateBands; virtual;
|
||||
published
|
||||
property Dithered: Boolean read FDithered write SetDithered default True;
|
||||
property Colors: TJvXPGradientColors read FColors write SetColors default 16;
|
||||
property Enabled: Boolean read FEnabled write SetEnabled default False;
|
||||
property EndColor: TColor read FEndColor write SetEndColor default clSilver;
|
||||
property StartColor: TColor read FStartColor write SetStartColor default clGray;
|
||||
property Style: TJvXPGradientStyle read FGradientStyle write SetGradientStyle default gsLeft;
|
||||
end;
|
||||
******************** NOT CONVERTED *)
|
||||
|
||||
implementation
|
||||
|
||||
{$R ../../resource/JvXPCore.res}
|
||||
|
||||
//=== { TJvXPCustomControl } =================================================
|
||||
|
||||
constructor TJvXPCustomControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csOpaque, csReplicatable];
|
||||
DoubleBuffered := True;
|
||||
ExControlStyle := [csRedrawEnabledChanged, csRedrawFocusedChanged,
|
||||
csRedrawMouseDown, csRedrawMouseEnter, csRedrawMouseLeave, csRedrawMouseUp,
|
||||
csRedrawParentColorChanged, csRedrawCaptionChanged];
|
||||
FClicking := False;
|
||||
FDrawState := [dsDefault];
|
||||
FIsLocked := False;
|
||||
FIsSibling := False;
|
||||
FModalResult := 0;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.SetVersion(const Value: string);
|
||||
begin
|
||||
// disallow changing this property.
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.BeginUpdate;
|
||||
begin
|
||||
FIsLocked := True;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.EndUpdate;
|
||||
begin
|
||||
FIsLocked := False;
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.LockedInvalidate;
|
||||
begin
|
||||
if not IsLocked then
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.InternalRedraw;
|
||||
begin
|
||||
if not FIsLocked then
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMDialogChar(var Msg: TCMDialogChar);
|
||||
begin
|
||||
with Msg do
|
||||
if IsAccel(CharCode, Caption) and CanFocus and
|
||||
(Focused or ((GetKeyState(VK_MENU) and $8000) <> 0)) then
|
||||
begin
|
||||
Click;
|
||||
Result := 1;
|
||||
end
|
||||
else
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMBorderChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "BorderChanged" to hook.
|
||||
inherited;
|
||||
HookBorderChanged;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMEnabledChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "EnabledChanged" to hook.
|
||||
inherited;
|
||||
HookEnabledChanged;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMFocusChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "FocusChanged" to hook.
|
||||
inherited;
|
||||
HookFocusedChanged;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMMouseEnter(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "MouseEnter" to hook.
|
||||
inherited;
|
||||
HookMouseEnter;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMMouseLeave(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "MouseLeave" to hook.
|
||||
inherited;
|
||||
HookMouseLeave;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMParentColorChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "ParentColorChanged" to hook.
|
||||
inherited;
|
||||
HookParentColorChanged;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.CMParentFontChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "ParentFontChanged" to hook.
|
||||
inherited;
|
||||
HookParentFontChanged;
|
||||
end;
|
||||
|
||||
//LCL doesnt fire it...
|
||||
(*
|
||||
procedure TJvXPCustomControl.CMParentFontChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "ParentFontChanged" to hook.
|
||||
inherited;
|
||||
HookParentFontChanged;
|
||||
end;
|
||||
procedure TJvXPCustomControl.CMTextChanged(var Msg: TLMessage);
|
||||
begin
|
||||
// delegate message "TextChanged" to hook.
|
||||
inherited;
|
||||
HookTextChanged;
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure TJvXPCustomControl.Resize;
|
||||
begin
|
||||
inherited;
|
||||
//HookResized;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.TextChanged;
|
||||
begin
|
||||
// delegate message "TextChanged" to hook.
|
||||
inherited;
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.WMMouseMove(var Msg: TLMMouse);
|
||||
begin
|
||||
// delegate message "MouseMove" to hook.
|
||||
inherited;
|
||||
HookMouseMove(Msg.XPos, Msg.YPos);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.WMSize(var Msg: TLMSize);
|
||||
begin
|
||||
// delegate message "Size" to hook.
|
||||
inherited;
|
||||
HookResized;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.WMWindowPosChanged(var Msg: TLMWindowPosChanged);
|
||||
begin
|
||||
// delegate message "WindowPosChanged" to hook.
|
||||
inherited;
|
||||
HookPosChanged;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.MouseDown(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
// delegate message "MouseDown" to hook.
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Button = mbLeft then
|
||||
begin
|
||||
FClicking := True;
|
||||
HookMouseDown;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.MouseUp(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
// delegate message "MouseUp" to hook.
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if FClicking then
|
||||
begin
|
||||
FClicking := False;
|
||||
HookMouseUp;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.Click;
|
||||
var
|
||||
Form: TCustomForm;
|
||||
begin
|
||||
Form := GetParentForm(Self);
|
||||
if Form <> nil then
|
||||
Form.ModalResult := ModalResult;
|
||||
inherited Click;
|
||||
end;
|
||||
|
||||
//
|
||||
// hooks are used to interrupt default windows messages in an easier
|
||||
// way - it's possible to override them in descendant classes.
|
||||
// Beware of multiple redraw calls - if you know that the calling
|
||||
// hooks always redraws the component, use the lock i.e. unlock methods
|
||||
// (rom) or LockedInvalidate.
|
||||
|
||||
procedure TJvXPCustomControl.HookBorderChanged;
|
||||
begin
|
||||
// this hook is called, if the border property was changed.
|
||||
// in that case we normaly have to redraw the control.
|
||||
if csRedrawBorderChanged in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookEnabledChanged;
|
||||
begin
|
||||
// this hook is called, if the enabled property was switched.
|
||||
// in that case we normaly have to redraw the control.
|
||||
if csRedrawEnabledChanged in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookFocusedChanged;
|
||||
begin
|
||||
// this hook is called, if the currently focused control was changed.
|
||||
if Focused then
|
||||
Include(FDrawState, dsFocused)
|
||||
else
|
||||
begin
|
||||
Exclude(FDrawState, dsFocused);
|
||||
Exclude(FDrawState, dsClicked);
|
||||
end;
|
||||
FIsSibling := GetParentForm(Self).ActiveControl is TJvXPCustomControl;
|
||||
if csRedrawFocusedChanged in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookMouseEnter;
|
||||
begin
|
||||
// this hook is called, if the user moves (hover) the mouse over the control.
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
Include(FDrawState, dsHighlight);
|
||||
if csRedrawMouseEnter in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
if Assigned(FOnMouseEnter) then
|
||||
FOnMouseEnter(Self);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookMouseLeave;
|
||||
begin
|
||||
// this hook is called, if the user moves the mouse away (unhover) from
|
||||
// the control.
|
||||
if not (csDesigning in ComponentState) then
|
||||
begin
|
||||
Exclude(FDrawState, dsHighlight);
|
||||
if csRedrawMouseLeave in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
if Assigned(FOnMouseLeave) then
|
||||
FOnMouseLeave(Self);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookMouseMove(X: Integer = 0; Y: Integer = 0);
|
||||
begin
|
||||
// this hook is called if the user moves the mouse inside the control.
|
||||
if not (csDesigning in ComponentState) then
|
||||
if csRedrawMouseMove in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookMouseDown;
|
||||
begin
|
||||
// this hook is called, if the user presses the left mouse button over the
|
||||
// controls.
|
||||
if not Focused and CanFocus then
|
||||
SetFocus;
|
||||
Include(FDrawState, dsClicked);
|
||||
if csRedrawMouseDown in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookMouseUp;
|
||||
var
|
||||
CurrentPos: TPoint;
|
||||
NewControl: TWinControl;
|
||||
begin
|
||||
// this hook is called, if the user releases the left mouse button.
|
||||
begin
|
||||
Exclude(FDrawState, dsClicked);
|
||||
if csRedrawMouseUp in ExControlStyle then
|
||||
InternalRedraw;
|
||||
|
||||
// does the cursor is over another supported control?
|
||||
GetCursorPos(CurrentPos);
|
||||
//TODO:
|
||||
//NewControl := FindVCLWindow(CurrentPos);
|
||||
NewControl := nil;
|
||||
if (NewControl <> nil) and (NewControl <> Self) and
|
||||
(NewControl.InheritsFrom(TJvXPCustomControl)) then
|
||||
TJvXPCustomControl(NewControl).HookMouseEnter;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookParentColorChanged;
|
||||
begin
|
||||
// this hook is called if, the parent color was changed.
|
||||
if csRedrawParentColorChanged in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookParentFontChanged;
|
||||
begin
|
||||
// this hook is called if, the parent font was changed.
|
||||
if csRedrawParentFontChanged in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookPosChanged;
|
||||
begin
|
||||
// this hook is called, if the window position was changed.
|
||||
if csRedrawPosChanged in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookResized;
|
||||
begin
|
||||
// this hook is called, if the control was resized.
|
||||
if csRedrawResized in ExControlStyle then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomControl.HookTextChanged;
|
||||
begin
|
||||
// this hook is called, if the caption was changed.
|
||||
if (csRedrawCaptionChanged in ExControlStyle) and
|
||||
not (csCreating in ControlState)
|
||||
then
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
|
||||
//=== { TJvXPStyle } =========================================================
|
||||
|
||||
constructor TJvXPStyle.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create;
|
||||
Parent := TJvXPCustomStyleControl(AOwner);
|
||||
FTheme := WindowsXP;
|
||||
FUseStyleManager := True;
|
||||
end;
|
||||
|
||||
procedure TJvXPStyle.SetTheme(Value: TJvXPTheme);
|
||||
begin
|
||||
if Value <> FTheme then
|
||||
begin
|
||||
FTheme := Value;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvXPStyle.GetTheme: TJvXPTheme;
|
||||
begin
|
||||
Result := FTheme;
|
||||
if FUseStyleManager and Assigned(Parent.StyleManager) then
|
||||
Result := Parent.StyleManager.Theme;
|
||||
end;
|
||||
|
||||
procedure TJvXPStyle.SetUseStyleManager(Value: Boolean);
|
||||
begin
|
||||
if Value <> FUseStyleManager then
|
||||
begin
|
||||
FUseStyleManager := Value;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
//=== { TJvXPStyleManager } ==================================================
|
||||
|
||||
constructor TJvXPStyleManager.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FControls := TList.Create;
|
||||
FTheme := WindowsXP;
|
||||
end;
|
||||
|
||||
destructor TJvXPStyleManager.Destroy;
|
||||
begin
|
||||
InvalidateControls;
|
||||
FreeNotifyControls;
|
||||
FControls.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPStyleManager.FreeNotifyControls;
|
||||
var
|
||||
J: Integer;
|
||||
begin
|
||||
for J := 0 to FControls.Count - 1 do
|
||||
TJvXPCustomControl(FControls[J]).Notification(self, opRemove);
|
||||
end;
|
||||
|
||||
procedure TJvXPStyleManager.InvalidateControls;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to FControls.Count - 1 do
|
||||
with TJvXPCustomControl(FControls[I]) do
|
||||
InternalRedraw;
|
||||
end;
|
||||
|
||||
procedure TJvXPStyleManager.SetTheme(Value: TJvXPTheme);
|
||||
begin
|
||||
if Value <> FTheme then
|
||||
begin
|
||||
FTheme := Value;
|
||||
if Assigned(FOnThemeChanged) then
|
||||
FOnThemeChanged(Self);
|
||||
InvalidateControls;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPStyleManager.RegisterControls(const AControls: array of TJvXPCustomControl);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := Low(AControls) to High(AControls) do
|
||||
if FControls.IndexOf(AControls[I]) = -1 then
|
||||
FControls.Add(AControls[I]);
|
||||
end;
|
||||
|
||||
procedure TJvXPStyleManager.UnregisterControls(const AControls: array of TJvXPCustomControl);
|
||||
var
|
||||
I, J: Integer;
|
||||
begin
|
||||
for I := Low(AControls) to High(AControls) do
|
||||
begin
|
||||
J := FControls.IndexOf(AControls[I]);
|
||||
if J <> -1 then
|
||||
FControls.Delete(J);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
//=== { TJvXPCustomStyleControl } ============================================
|
||||
|
||||
constructor TJvXPCustomStyleControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FStyle := TJvXPStyle.Create(Self);
|
||||
FStyleManager := nil;
|
||||
end;
|
||||
|
||||
destructor TJvXPCustomStyleControl.Destroy;
|
||||
begin
|
||||
if FStyleManager <> nil then
|
||||
FStyleManager.UnregisterControls([Self]);
|
||||
FStyle.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomStyleControl.Notification(AComponent: TComponent;
|
||||
Operation: TOperation);
|
||||
begin
|
||||
if (AComponent is TJvXPStyleManager) and (Operation = opRemove) then
|
||||
FStyleManager := nil;
|
||||
inherited Notification(AComponent, Operation);
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomStyleControl.SetStyleManager(Value: TJvXPStyleManager);
|
||||
begin
|
||||
if Value <> FStyleManager then
|
||||
begin
|
||||
if Value <> nil then
|
||||
Value.RegisterControls([Self])
|
||||
else
|
||||
FStyleManager.UnregisterControls([Self]);
|
||||
FStyleManager := Value;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
(******************** NOT CONVERTED
|
||||
//=== { TJvXPGradient } ======================================================
|
||||
|
||||
constructor TJvXPGradient.Create(AOwner: TControl);
|
||||
begin
|
||||
inherited Create;
|
||||
Parent := TJvXPCustomControl(AOwner);
|
||||
Bitmap := TBitmap.Create;
|
||||
FColors := 16;
|
||||
FDithered := True;
|
||||
FEnabled := False;
|
||||
FEndColor := clSilver;
|
||||
FGradientStyle := gsLeft;
|
||||
FStartColor := clGray;
|
||||
end;
|
||||
|
||||
destructor TJvXPGradient.Destroy;
|
||||
begin
|
||||
Bitmap.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.RecreateBands;
|
||||
begin
|
||||
if Assigned(Bitmap) then
|
||||
JvXPCreateGradientRect(Parent.Width, Parent.Height, FStartColor, FEndColor,
|
||||
FColors, FGradientStyle, FDithered, Bitmap);
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.SetDithered(Value: Boolean);
|
||||
begin
|
||||
if FDithered <> Value then
|
||||
begin
|
||||
FDithered := Value;
|
||||
RecreateBands;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.SetColors(Value: TJvXPGradientColors);
|
||||
begin
|
||||
if FColors <> Value then
|
||||
begin
|
||||
FColors := Value;
|
||||
RecreateBands;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.SetEnabled(Value: Boolean);
|
||||
begin
|
||||
if FEnabled <> Value then
|
||||
begin
|
||||
FEnabled := Value;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.SetEndColor(Value: TColor);
|
||||
begin
|
||||
if FEndColor <> Value then
|
||||
begin
|
||||
FEndColor := Value;
|
||||
RecreateBands;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.SetGradientStyle(Value: TJvXPGradientStyle);
|
||||
begin
|
||||
if FGradientStyle <> Value then
|
||||
begin
|
||||
FGradientStyle := Value;
|
||||
RecreateBands;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPGradient.SetStartColor(Value: TColor);
|
||||
begin
|
||||
if FStartColor <> Value then
|
||||
begin
|
||||
FStartColor := Value;
|
||||
RecreateBands;
|
||||
Parent.InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
******************** NOT CONVERTED *)
|
||||
|
||||
end.
|
||||
|
||||
451
components/jvcllaz/run/JvXPCtrls/JvXPCoreUtils.pas
Normal file
451
components/jvcllaz/run/JvXPCtrls/JvXPCoreUtils.pas
Normal file
@ -0,0 +1,451 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
The contents of this file are subject to the Mozilla Public License
|
||||
Version 1.1 (the "License"); you may not use this file except in compliance
|
||||
with the License. You may obtain a copy of the License at
|
||||
http://www.mozilla.org/MPL/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvXPCoreUtils.PAS, released on 2004-01-01.
|
||||
|
||||
The Initial Developer of the Original Code is Marc Hoffman.
|
||||
Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG.
|
||||
Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.sourceforge.net
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id: JvXPCoreUtils.pas 11400 2007-06-28 21:24:06Z ahuser $
|
||||
|
||||
// Ported to Lazarus (no too hard after all) by Sergio Samayoa - september 2007.
|
||||
// Still dont tested on linux.
|
||||
|
||||
unit JvXPCoreUtils;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, Controls, Graphics, LCLIntf, LCLType, SysUtils,
|
||||
TypInfo, JvXPCore;
|
||||
|
||||
function JvXPMethodsEqual(const Method1, Method2: TMethod): Boolean;
|
||||
|
||||
procedure JvXPDrawLine(const ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer);
|
||||
|
||||
procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer; const StartColor,
|
||||
EndColor: TColor; const AColors: TJvXPGradientColors; const Style: TJvXPGradientStyle;
|
||||
const Dithered: Boolean; var Bitmap: TBitmap);
|
||||
|
||||
procedure JvXPAdjustBoundRect(const BorderWidth: Byte;
|
||||
const ShowBoundLines: Boolean; const BoundLines: TJvXPBoundLines; var Rect: TRect);
|
||||
|
||||
procedure JvXPDrawBoundLines(const ACanvas: TCanvas; const BoundLines: TJvXPBoundLines;
|
||||
const AColor: TColor; const Rect: TRect);
|
||||
|
||||
procedure JvXPConvertToGray2(ABitmap: TBitmap);
|
||||
|
||||
procedure JvXPRenderText(const AParent: TControl; const ACanvas: TCanvas;
|
||||
ACaption: TCaption; const AFont: TFont; const AEnabled, AShowAccelChar: Boolean;
|
||||
var ARect: TRect; AFlags: Integer);
|
||||
|
||||
procedure JvXPFrame3D(const ACanvas: TCanvas; const ARect: TRect;
|
||||
const TopColor, BottomColor: TColor; const Swapped: Boolean = False);
|
||||
|
||||
procedure JvXPColorizeBitmap(ABitmap: TBitmap; const AColor: TColor);
|
||||
|
||||
procedure JvXPSetDrawFlags(const AAlignment: TAlignment; const AWordWrap: Boolean;
|
||||
var Flags: Integer);
|
||||
|
||||
procedure JvXPPlaceText(const AParent: TControl; const ACanvas: TCanvas;
|
||||
const AText: TCaption; const AFont: TFont; const AEnabled, AShowAccelChar: Boolean;
|
||||
const AAlignment: TAlignment; const AWordWrap: Boolean; var Rect: TRect);
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
IntfGraphics, fpCanvas, fpImage, fpImgCanv;
|
||||
|
||||
function JvXPMethodsEqual(const Method1, Method2: TMethod): Boolean;
|
||||
begin
|
||||
Result := (Method1.Code = Method2.Code) and (Method1.Data = Method2.Data);
|
||||
end;
|
||||
|
||||
// Ignoring "AColors" and "Dithered"
|
||||
procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer;
|
||||
const StartColor, EndColor: TColor; const AColors: TJvXPGradientColors;
|
||||
const Style: TJvXPGradientStyle; const Dithered: Boolean; var Bitmap: TBitmap);
|
||||
begin
|
||||
if (AHeight <= 0) or (AWidth <= 0) then
|
||||
Exit;
|
||||
Bitmap.Height := AHeight;
|
||||
Bitmap.Width := AWidth;
|
||||
Bitmap.PixelFormat := pf24bit;
|
||||
case Style of
|
||||
gsLeft:
|
||||
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), StartColor, EndColor, gdHorizontal);
|
||||
gsRight:
|
||||
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), EndColor, StartColor, gdHorizontal);
|
||||
gsTop:
|
||||
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), StartColor, EndColor, gdVertical);
|
||||
gsBottom:
|
||||
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), EndColor, StartColor, gdVertical);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
(*
|
||||
// Dithered is ignored at the moment...
|
||||
procedure JvXPCreateGradientRect(const AWidth, AHeight: Integer; const StartColor,
|
||||
EndColor: TColor; const AColors: TJvXPGradientColors; const Style: TJvXPGradientStyle;
|
||||
const Dithered: Boolean; var Bitmap: TBitmap);
|
||||
{ // Short version...
|
||||
var
|
||||
gd: TGradientDirection;
|
||||
begin
|
||||
if (AHeight <= 0) or (AWidth <= 0) then
|
||||
Exit;
|
||||
Bitmap.Height := AHeight;
|
||||
Bitmap.Width := AWidth;
|
||||
Bitmap.PixelFormat := pf24bit;
|
||||
if Style in [gsLeft, gsRight] then
|
||||
gd := gdHorizontal
|
||||
else
|
||||
gd := gdVertical;
|
||||
Bitmap.Canvas.GradientFill(Rect(0, 0, AWidth, AHeight), StartColor, EndColor, gd);
|
||||
end;
|
||||
}
|
||||
const
|
||||
PixelCountMax = 32768;
|
||||
DitherDepth = 16;
|
||||
type
|
||||
TGradientBand = array [0..255] of TColor;
|
||||
TRGBMap = packed record
|
||||
case Boolean of
|
||||
True:
|
||||
(RGBVal: DWord);
|
||||
False:
|
||||
(R, G, B, D: Byte);
|
||||
end;
|
||||
var
|
||||
iLoop, xLoop, yLoop, XX, YY: Integer;
|
||||
iBndS, iBndE: Integer;
|
||||
GBand: TGradientBand;
|
||||
intfImg: TLazIntfImage;
|
||||
cnv: TFPImageCanvas;
|
||||
clr: TFPColor;
|
||||
imgHandle, imgMaskHandle: HBitmap;
|
||||
tempBitmap: TBitmap;
|
||||
|
||||
procedure CalculateGradientBand;
|
||||
var
|
||||
rR, rG, rB: Real;
|
||||
lCol, hCol: TRGBMap;
|
||||
iStp: Integer;
|
||||
begin
|
||||
if Style in [gsLeft, gsTop] then
|
||||
begin
|
||||
lCol.RGBVal := ColorToRGB(StartColor);
|
||||
hCol.RGBVal := ColorToRGB(EndColor);
|
||||
end
|
||||
else
|
||||
begin
|
||||
lCol.RGBVal := ColorToRGB(EndColor);
|
||||
hCol.RGBVal := ColorToRGB(StartColor);
|
||||
end;
|
||||
rR := (hCol.R - lCol.R) / (AColors - 1);
|
||||
rG := (hCol.G - lCol.G) / (AColors - 1);
|
||||
rB := (hCol.B - lCol.B) / (AColors - 1);
|
||||
for iStp := 0 to (AColors - 1) do
|
||||
GBand[iStp] := RGB(
|
||||
lCol.R + Round(rR * iStp),
|
||||
lCol.G + Round(rG * iStp),
|
||||
lCol.B + Round(rB * iStp));
|
||||
end;
|
||||
|
||||
begin
|
||||
// Exit if Height or Width are not positive. If not, the calls would lead to
|
||||
// GDI errors about "Invalid parameter" and/or "Out Of Resources".
|
||||
if (AHeight <= 0) or (AWidth <= 0) then
|
||||
Exit;
|
||||
|
||||
Bitmap.Height := AHeight;
|
||||
Bitmap.Width := AWidth;
|
||||
Bitmap.PixelFormat := pf24bit;
|
||||
|
||||
CalculateGradientBand;
|
||||
|
||||
intfImg := TLazIntfImage.Create(0, 0);
|
||||
intfImg.LoadFromBitmap(Bitmap.Handle, Bitmap.MaskHandle);
|
||||
cnv := TFPImageCanvas.Create(intfImg);
|
||||
cnv.Brush.FPColor := TColorToFPColor(StartColor);
|
||||
//cnv.FillRect(Bounds(0, 0, AWidth, AHeight));
|
||||
|
||||
if Style in [gsLeft, gsRight] then
|
||||
begin
|
||||
for iLoop := 0 to AColors - 1 do begin
|
||||
iBndS := MulDiv(iLoop, AWidth, AColors);
|
||||
iBndE := MulDiv(iLoop + 1, AWidth, AColors);
|
||||
cnv.Brush.FPColor := TColorToFPColor(GBand[iLoop]);
|
||||
cnv.FillRect(iBnds, 0, iBndE, AHeight);
|
||||
{
|
||||
if Dithered and (iLoop > 0) then
|
||||
begin
|
||||
clr := TColorToFPColor(GBand[iLoop - 1]);
|
||||
for yLoop := 0 to DitherDepth - 1 do
|
||||
if yLoop < AHeight then
|
||||
for xLoop := 0 to AWidth div (AColors - 1) do
|
||||
begin
|
||||
XX := iBndS + Random(xLoop);
|
||||
if (XX < AWidth) and (XX > -1) then
|
||||
cnv.Colors[XX, yLoop] := clr;
|
||||
end;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
{
|
||||
if Dithered then
|
||||
for yLoop := 1 to AHeight div DitherDepth do
|
||||
for xLoop := 0 to AWidth - 1 do
|
||||
cnv.Colors[xLoop, yLoop * DitherDepth] := cnv.Colors[xLoop, 0];
|
||||
}
|
||||
end
|
||||
else
|
||||
begin
|
||||
for iLoop := 0 to AColors - 1 do
|
||||
begin
|
||||
iBndS := MulDiv(iLoop, AHeight, AColors);
|
||||
iBndE := MulDiv(iLoop + 1, AHeight, AColors);
|
||||
cnv.Brush.FPColor := TColorToFPColor(GBand[iLoop]);
|
||||
cnv.FillRect(0, iBndS, AWidth, iBndS + iBndE);
|
||||
{
|
||||
if Dithered and (iLoop > 0) then
|
||||
begin
|
||||
clr := TColorToFPColor(GBand[iLoop - 1]);
|
||||
for yLoop := 0 to AHeight div (AColors - 1) do
|
||||
begin
|
||||
YY := iBndS + Random(yLoop);
|
||||
if (YY < AHeight) and (YY > -1) then
|
||||
for xLoop := 0 to DitherDepth - 1 do
|
||||
if xLoop < AWidth then
|
||||
cnv.Colors[xLoop, YY] := clr;
|
||||
end;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
{
|
||||
for xLoop := 0 to AWidth div DitherDepth do
|
||||
for yLoop := 0 to AHeight - 1 do
|
||||
cnv.Colors[xLoop * DitherDepth, yLoop] := cnv.Colors[0, yLoop];
|
||||
}
|
||||
end;
|
||||
|
||||
intfImg.CreateBitmaps(imgHandle, imgMaskHandle, false);
|
||||
tempBitmap := TBitmap.Create;
|
||||
tempBitmap.Handle := imgHandle;
|
||||
tempBitmap.MaskHandle := imgMaskHandle;
|
||||
Bitmap.Canvas.Draw(0, 0, tempBitmap);
|
||||
|
||||
tempBitmap.Free;
|
||||
cnv.Free;
|
||||
intfImg.Free;
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure JvXPDrawLine(const ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
with ACanvas do
|
||||
begin
|
||||
MoveTo(X1, Y1);
|
||||
LineTo(X2, Y2);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure JvXPAdjustBoundRect(const BorderWidth: Byte;
|
||||
const ShowBoundLines: Boolean; const BoundLines: TJvXPBoundLines;
|
||||
var Rect: TRect);
|
||||
begin
|
||||
InflateRect(Rect, -BorderWidth, -BorderWidth);
|
||||
if not ShowBoundLines then
|
||||
Exit;
|
||||
if blLeft in BoundLines then
|
||||
Inc(Rect.Left);
|
||||
if blRight in BoundLines then
|
||||
Dec(Rect.Right);
|
||||
if blTop in BoundLines then
|
||||
Inc(Rect.Top);
|
||||
if blBottom in BoundLines then
|
||||
Dec(Rect.Bottom);
|
||||
end;
|
||||
|
||||
procedure JvXPDrawBoundLines(const ACanvas: TCanvas; const BoundLines: TJvXPBoundLines;
|
||||
const AColor: TColor; const Rect: TRect);
|
||||
begin
|
||||
with ACanvas do
|
||||
begin
|
||||
Pen.Color := AColor;
|
||||
Pen.Style := psSolid;
|
||||
if blLeft in BoundLines then
|
||||
JvXPDrawLine(ACanvas, Rect.Left, Rect.Top, Rect.Left, Rect.Bottom - 1);
|
||||
if blTop in BoundLines then
|
||||
JvXPDrawLine(ACanvas, Rect.Left, Rect.Top, Rect.Right, Rect.Top);
|
||||
if blRight in BoundLines then
|
||||
JvXPDrawLine(ACanvas, Rect.Right - 1, Rect.Top, Rect.Right - 1, Rect.Bottom - 1);
|
||||
if blBottom in BoundLines then
|
||||
JvXPDrawLine(ACanvas, Rect.Top, Rect.Bottom - 1, Rect.Right, Rect.Bottom - 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure JvXPConvertToGray2(ABitmap: TBitmap);
|
||||
var
|
||||
x, y, c: Integer;
|
||||
PxlColor: TColor;
|
||||
begin
|
||||
for x := 0 to ABitmap.Width - 1 do
|
||||
for y := 0 to ABitmap.Height - 1 do
|
||||
begin
|
||||
PxlColor := ColorToRGB(ABitmap.Canvas.Pixels[x, y]);
|
||||
c := (PxlColor shr 16 + ((PxlColor shr 8) and $00FF) + PxlColor and $0000FF) div 3 + 100;
|
||||
if c > 255 then
|
||||
c := 255;
|
||||
ABitmap.Canvas.Pixels[x, y] := RGB(c, c, c);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure JvXPRenderText(const AParent: TControl; const ACanvas: TCanvas;
|
||||
ACaption: TCaption; const AFont: TFont; const AEnabled, AShowAccelChar: Boolean;
|
||||
var ARect: TRect; AFlags: Integer);
|
||||
|
||||
procedure DoDrawText;
|
||||
begin
|
||||
// (rom) Kludge! This will probably not work for CLX
|
||||
DrawText(ACanvas.Handle, PChar(ACaption), -1, ARect, AFlags);
|
||||
end;
|
||||
|
||||
begin
|
||||
if (AFlags and DT_CALCRECT <> 0) and ((ACaption = '') or AShowAccelChar and
|
||||
(ACaption[1] = '&') and (ACaption[2] = #0)) then
|
||||
ACaption := ACaption + ' ';
|
||||
if not AShowAccelChar then
|
||||
AFlags := AFlags or DT_NOPREFIX;
|
||||
// wp: To do - bidi
|
||||
// AFlags := AParent.DrawTextBiDiModeFlags(AFlags);
|
||||
with ACanvas do
|
||||
begin
|
||||
Font.Assign(AFont);
|
||||
if not AEnabled then
|
||||
Font.Color := dxColor_Msc_Dis_Caption_WXP;
|
||||
if not AEnabled then
|
||||
begin
|
||||
OffsetRect(ARect, 1, 1);
|
||||
Font.Color := clBtnHighlight;
|
||||
DoDrawText;
|
||||
OffsetRect(ARect, -1, -1);
|
||||
Font.Color := clBtnShadow;
|
||||
DoDrawText;
|
||||
end
|
||||
else
|
||||
DoDrawText;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure JvXPFrame3D(const ACanvas: TCanvas; const ARect: TRect;
|
||||
const TopColor, BottomColor: TColor; const Swapped: Boolean = False);
|
||||
var
|
||||
ATopColor, ABottomColor: TColor;
|
||||
begin
|
||||
ATopColor := TopColor;
|
||||
ABottomColor := BottomColor;
|
||||
if Swapped then
|
||||
begin
|
||||
ATopColor := BottomColor;
|
||||
ABottomColor := TopColor;
|
||||
end;
|
||||
with ACanvas do
|
||||
begin
|
||||
Pen.Color := ATopColor;
|
||||
// 21.09.07 - SESS
|
||||
Polyline([
|
||||
Classes.Point(ARect.Left, ARect.Bottom - 1),
|
||||
Classes.Point(ARect.Left, ARect.Top),
|
||||
Classes.Point(ARect.Right - 1, ARect.Top)]);
|
||||
Pen.Color := ABottomColor;
|
||||
Polyline([
|
||||
Classes.Point(ARect.Right - 1, ARect.Top + 1),
|
||||
Classes.Point(ARect.Right - 1 , ARect.Bottom - 1),
|
||||
Classes.Point(ARect.Left, ARect.Bottom - 1)]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure JvXPColorizeBitmap(ABitmap: TBitmap; const AColor: TColor);
|
||||
var
|
||||
ColorMap: TBitmap;
|
||||
Rect: TRect;
|
||||
begin
|
||||
Rect := Bounds(0, 0, ABitmap.Width, ABitmap.Height);
|
||||
ColorMap := TBitmap.Create;
|
||||
try
|
||||
ColorMap.Assign(ABitmap);
|
||||
ABitmap.FreeImage;
|
||||
with ColorMap.Canvas do
|
||||
begin
|
||||
Brush.Color := AColor;
|
||||
BrushCopy(Rect, ABitmap, Rect, clBlack);
|
||||
end;
|
||||
ABitmap.Assign(ColorMap);
|
||||
finally
|
||||
ColorMap.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure JvXPSetDrawFlags(const AAlignment: TAlignment; const AWordWrap: Boolean;
|
||||
var Flags: Integer);
|
||||
begin
|
||||
Flags := DT_END_ELLIPSIS;
|
||||
case AAlignment of
|
||||
taLeftJustify:
|
||||
Flags := Flags or DT_LEFT;
|
||||
taCenter:
|
||||
Flags := Flags or DT_CENTER;
|
||||
taRightJustify:
|
||||
Flags := Flags or DT_RIGHT;
|
||||
end;
|
||||
if not AWordWrap then
|
||||
Flags := Flags or DT_SINGLELINE
|
||||
else
|
||||
Flags := Flags or DT_WORDBREAK;
|
||||
end;
|
||||
|
||||
procedure JvXPPlaceText(const AParent: TControl; const ACanvas: TCanvas; const AText: TCaption;
|
||||
const AFont: TFont; const AEnabled, AShowAccelChar: Boolean; const AAlignment: TAlignment;
|
||||
const AWordWrap: Boolean; var Rect: TRect);
|
||||
var
|
||||
Flags, DX, OH, OW: Integer;
|
||||
begin
|
||||
OH := Rect.Bottom - Rect.Top;
|
||||
OW := Rect.Right - Rect.Left;
|
||||
JvXPSetDrawFlags(AAlignment, AWordWrap, Flags);
|
||||
JvXPRenderText(AParent, ACanvas, AText, AFont, AEnabled, AShowAccelChar, Rect,
|
||||
Flags or DT_CALCRECT);
|
||||
if AAlignment = taRightJustify then
|
||||
DX := OW - (Rect.Right + Rect.Left)
|
||||
else
|
||||
if AAlignment = taCenter then
|
||||
DX := (OW - Rect.Right) div 2
|
||||
else
|
||||
DX := 0;
|
||||
OffsetRect(Rect, DX, (OH - Rect.Bottom) div 2);
|
||||
JvXPRenderText(AParent, ACanvas, AText, AFont, AEnabled, AShowAccelChar, Rect, Flags);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user