{*************************************************************************} { TAdvOfficeButtons components } { for Delphi & C++Builder } { } { written by } { TMS Software } { copyright © 2007 - 2008 } { Email : info@tmssoftware.com } { Web : http://www.tmssoftware.com } { } { The source code is given as is. The author is not responsible } { for any possible damage done due to the use of this code. } { The component can be freely used in any application. The complete } { source code remains property of the author and may not be distributed, } { published, given or sold in any form as such. No parts of the source } { code can be included in any other component or application without } { written authorization of the author. } {*************************************************************************} unit AdvOfficeButtons; {$I TMSDEFS.INC} {$R AdvOfficeButtons.res} {$DEFINE REMOVESTRIP} {$DEFINE REMOVEDRAW} interface uses SysUtils, Windows, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, Buttons, ComObj, ActiveX, PictureContainer, AdvGroupBox; const MAJ_VER = 1; // Major version nr. MIN_VER = 1; // Minor version nr. REL_VER = 0; // Release nr. BLD_VER = 8; // Build nr. // version history // 1.0.0.1 : Fixed compatibility issue with TRadioGroup of TAdvOfficeRadioGroup // 1.0.1.0 : Improved : exposed Visible property in TAdvOfficeRadioButton // 1.0.2.0 : New : Added OnEnter, OnExit events in TAdvOfficeRadioButton, TAdvOfficeCheckBox // 1.0.3.0 : Improved : painting hot state of controls // 1.1.0.0 : New property Value added in AdvOfficeCheckGroup // : New component TDBAdvOfficeCheckGroup added // 1.1.0.1 : Improved : painting of focus rectangle // 1.1.0.2 : Fixed : issue with ImageIndex for caption // 1.1.0.3 : Fixed : issue with arrow keys & TAdvOfficeRadioGroup // 1.1.0.4 : Fixed : issue with dbl click & mouseup handling // 1.1.0.5 : Fixed : small painting issue with ClearType fonts // 1.1.0.6 : Fixed : issue with runtime creating controls // 1.1.0.7 : Fixed : issue with setting separate radiobuttons in group as disabled // 1.1.0.8 : Fixed : issue with OnClick event for TAdvOfficeRadioGroup type TAnchorClick = procedure (Sender:TObject; Anchor:string) of object; TCustomAdvOfficeCheckBox = class(TCustomControl) private FDown:Boolean; FState:TCheckBoxState; FFocused:Boolean; FReturnIsTab:Boolean; FImages:TImageList; FAnchor: string; FAnchorClick: TAnchorClick; FAnchorEnter: TAnchorClick; FAnchorExit: TAnchorClick; FURLColor: TColor; FImageCache: THTMLPictureCache; FBtnVAlign: TTextLayout; FAlignment: TLeftRight; FEllipsis: Boolean; FCaption: string; FContainer: TPictureContainer; FShadowOffset: Integer; FShadowColor: TColor; FIsWinXP: Boolean; FHot: Boolean; FClicksDisabled: Boolean; FOldCursor: TCursor; FReadOnly: Boolean; {$IFNDEF TMSDOTNET} FBkgBmp: TBitmap; FBkgCache: boolean; FTransparentCaching: boolean; {$ENDIF} FDrawBkg: boolean; FGotClick: boolean; procedure WMEraseBkGnd(var Message:TMessage); message WM_ERASEBKGND; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure SetState(Value:TCheckBoxState); procedure SetChecked(Value:Boolean); function GetChecked:Boolean; procedure SetCaption(Value: string); procedure SetImages(const Value: TImageList); procedure SetURLColor(const Value:TColor); function IsAnchor(x,y:integer):string; procedure SetButtonVertAlign(const Value: TTextLayout); procedure SetAlignment(const Value: TLeftRight); procedure SetEllipsis(const Value: Boolean); procedure SetContainer(const Value: TPictureContainer); procedure SetShadowColor(const Value: TColor); procedure SetShadowOffset(const Value: Integer); function GetVersion: string; procedure SetVersion(const Value: string); {$IFNDEF TMSDOTNET} procedure DrawParentImage (Control: TControl; Dest: TCanvas); {$ENDIF} protected function GetVersionNr: Integer; virtual; procedure Notification(AComponent: TComponent; AOperation: TOperation); override; procedure DrawCheck; procedure Paint; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState;X, Y: Integer); override; procedure KeyDown(var Key:Word;Shift:TShiftSTate); override; procedure KeyUp(var Key:Word;Shift:TShiftSTate); override; procedure SetDown(Value:Boolean); procedure DoEnter; override; procedure DoExit; override; procedure Loaded; override; property Checked: Boolean read GetChecked write SetChecked default False; property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Toggle; virtual; {$IFNDEF TMSDOTNET} procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; property TransparentChaching: boolean read FTransparentCaching write FTransparentCaching; {$ENDIF} property DrawBkg: Boolean read FDrawBkg write FDrawBkg; published property Action; property Anchors; property Constraints; property Color; property Alignment: TLeftRight read FAlignment write SetAlignment; property ButtonVertAlign: TTextLayout read FBtnVAlign write setButtonVertAlign default tlTop; property Caption: string read FCaption write SetCaption; property Down: Boolean read FDown write SetDown default False; property DragCursor; property DragKind; property DragMode; property Ellipsis: Boolean read FEllipsis write SetEllipsis default False; property Enabled; property Font; property Images: TImageList read FImages write SetImages; property ParentFont; property ParentColor; property PictureContainer: TPictureContainer read FContainer write SetContainer; property PopupMenu; property ReadOnly: Boolean read FReadOnly write FReadOnly default False; property ReturnIsTab: Boolean read FReturnIsTab write FReturnIsTab; property ShadowColor: TColor read FShadowColor write SetShadowColor default clGray; property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 1; property ShowHint; property State: TCheckBoxState read FState write SetState default cbUnchecked; property TabOrder; property TabStop; property URLColor: TColor read FURLColor write SetURLColor default clBlue; property Visible; property OnClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnAnchorClick: TAnchorClick read fAnchorClick write fAnchorClick; property OnAnchorEnter: TAnchorClick read fAnchorEnter write fAnchorEnter; property OnAnchorExit: TAnchorClick read fAnchorExit write fAnchorExit; property Version: string read GetVersion write SetVersion; end; TAdvOfficeCheckBox = class(TCustomAdvOfficeCheckBox) published property Checked; end; TAdvOfficeRadioButton = class(TCustomControl) private FDown: Boolean; FChecked: Boolean; FFocused: Boolean; FGroupIndex: Byte; FReturnIsTab: Boolean; FImages: TImageList; FAnchor: string; FAnchorClick: TAnchorClick; FAnchorEnter: TAnchorClick; FAnchorExit: TAnchorClick; FURLColor: TColor; FImageCache: THTMLPictureCache; FBtnVAlign: TTextLayout; FAlignment: TLeftRight; FEllipsis: Boolean; FCaption: string; FContainer: TPictureContainer; FShadowOffset: Integer; FShadowColor: TColor; FIsWinXP: Boolean; FHot: Boolean; FClicksDisabled: Boolean; FOldCursor: TCursor; {$IFNDEF TMSDOTNET} FBkgBmp: TBitmap; FBkgCache: boolean; FTransparentCaching: boolean; {$ENDIF} FDrawBkg: Boolean; FGotClick: boolean; procedure TurnSiblingsOff; procedure SetDown(Value:Boolean); procedure SetChecked(Value:Boolean); procedure SetImages(const Value: TImageList); procedure SetURLColor(const Value:TColor); function IsAnchor(x,y:integer):string; procedure WMLButtonDown(var Message:TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMEraseBkGnd(var Message:TMessage); message WM_ERASEBKGND; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; procedure SetButtonVertAlign(const Value: TTextLayout); procedure SetAlignment(const Value: TLeftRight); procedure SetEllipsis(const Value: Boolean); procedure SetCaption(const Value: string); procedure SetContainer(const Value: TPictureContainer); procedure SetShadowColor(const Value: TColor); procedure SetShadowOffset(const Value: Integer); function GetVersion: string; procedure SetVersion(const Value: string); function GetVersionNr: Integer; {$IFNDEF TMSDOTNET} procedure DrawParentImage (Control: TControl; Dest: TCanvas); {$ENDIF} protected procedure DrawRadio; procedure Paint; override; procedure Notification(AComponent: TComponent; AOperation: TOperation); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState;X, Y: Integer); override; procedure KeyDown(var Key:Word;Shift:TShiftSTate); override; procedure KeyUp(var Key:Word;Shift:TShiftSTate); override; procedure DoEnter; override; procedure DoExit; override; procedure Loaded; override; procedure Click; override; procedure DoClick; virtual; property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; {$IFNDEF TMSDOTNET} procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; property TransparentChaching: boolean read FTransparentCaching write FTransparentCaching; {$ENDIF} property DrawBkg: Boolean read FDrawBkg write FDrawBkg; published {$IFDEF DELPHI4_LVL} property Action; property Anchors; property Constraints; {$ENDIF} property Color; property Alignment: TLeftRight read fAlignment write SetAlignment; property URLColor:TColor read FURLColor write SetURLColor default clBlue; property ButtonVertAlign: TTextLayout read fBtnVAlign write SetButtonVertAlign default tlTop; property Caption: string read FCaption write SetCaption; property Checked:Boolean read FChecked write SetChecked default False; property Down:Boolean read FDown write SetDown default False; property DragCursor; {$IFDEF DELPHI4_LVL} property DragKind; {$ENDIF} property DragMode; property Ellipsis: Boolean read FEllipsis write SetEllipsis default False; property Enabled; property Font; property GroupIndex:Byte read FGroupIndex write FGroupIndex default 0; property Images:TImageList read fImages write SetImages; property ParentFont; property ParentColor; property PictureContainer: TPictureContainer read FContainer write SetContainer; property PopupMenu; property ReturnIsTab:Boolean read FReturnIsTab write FReturnIsTab; property ShadowColor: TColor read FShadowColor write SetShadowColor default clGray; property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 1; property ShowHint; property TabOrder; property TabStop; property OnClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnAnchorClick:TAnchorClick read fAnchorClick write fAnchorClick; property OnAnchorEnter:TAnchorClick read fAnchorEnter write fAnchorEnter; property OnAnchorExit:TAnchorClick read fAnchorExit write fAnchorExit; property Version: string read GetVersion write SetVersion; property Visible; end; TEnabledEvent = procedure (Sender:TObject; ItemIndex: Integer; var Enabled: Boolean) of object; TCustomAdvOfficeRadioGroup = class(TAdvGroupbox) private FButtons: TList; FItems: TStrings; FItemIndex: Integer; FColumns: Integer; FReading: Boolean; FUpdating: Boolean; FAlignment: TAlignment; FBtnVAlign: TTextLayout; FImages: TImageList; FContainer: TPictureContainer; FEllipsis: Boolean; FShadowOffset: Integer; FShadowColor: TColor; FOnIsEnabled: TEnabledEvent; FIsReadOnly: boolean; procedure ArrangeButtons; procedure ButtonClick(Sender: TObject); procedure ItemsChange(Sender: TObject); procedure SetButtonCount(Value: Integer); procedure SetColumns(Value: Integer); procedure SetItemIndex(Value: Integer); procedure SetItems(Value: TStrings); procedure UpdateButtons; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure SetAlignment(const Value: TAlignment); procedure SetButtonVertAlign(const Value: TTextLayout); procedure SetContainer(const Value: TPictureContainer); procedure SetImages(const Value: TImageList); procedure SetEllipsis(const Value: Boolean); procedure SetShadowColor(const Value: TColor); procedure SetShadowOffset(const Value: Integer); function GetVersion: string; procedure SetVersion(const Value: string); protected function GetVersionNr: Integer; virtual; procedure Loaded; override; procedure ReadState(Reader: TReader); override; function CanModify: Boolean; virtual; procedure Notification(AComponent: TComponent; AOperation: TOperation); override; property Columns: Integer read FColumns write SetColumns default 1; property ItemIndex: Integer read FItemIndex write SetItemIndex default -1; property Items: TStrings read FItems write SetItems; property IsReadOnly: boolean read FIsReadOnly write FIsReadOnly; public procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; {$IFDEF DELPHI4_LVL} procedure FlipChildren(AllLevels: Boolean); override; {$ENDIF} procedure PushKey(var Key: Char); procedure PushKeyDown(var Key: Word; Shift: TShiftState); published property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; property ButtonVertAlign: TTextLayout read fBtnVAlign write SetButtonVertAlign default tlTop; property Ellipsis: Boolean read FEllipsis write SetEllipsis; property Images: TImageList read FImages write SetImages; property PictureContainer: TPictureContainer read FContainer write SetContainer; property ShadowColor: TColor read FShadowColor write SetShadowColor default clSilver; property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 1; property OnIsEnabled: TEnabledEvent read FOnIsEnabled write FOnIsEnabled; property Version: string read GetVersion write SetVersion; end; TAdvOfficeRadioGroup = class(TCustomAdvOfficeRadioGroup) private protected public published property Align; {$IFDEF DELPHI4_LVL} property Anchors; property BiDiMode; property Constraints; property DragKind; property ParentBiDiMode; {$ENDIF} property Caption; property Color; property Columns; property Ctl3D; property DragCursor; property DragMode; property Enabled; property Font; property ItemIndex; property Items; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property OnClick; {$IFDEF DELPHI5_LVL} property OnContextPopup; {$ENDIF} property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; {$IFDEF DELPHI4_LVL} property OnEndDock; property OnStartDock; {$ENDIF} property OnStartDrag; end; TCustomAdvOfficeCheckGroup = class(TAdvGroupBox) private FButtons: TList; FItems: TStrings; FColumns: Integer; FReading: Boolean; FUpdating: Boolean; FAlignment: TAlignment; FBtnVAlign: TTextLayout; FImages: TImageList; FContainer: TPictureContainer; FEllipsis: Boolean; FShadowOffset: Integer; FShadowColor: TColor; FOnIsEnabled: TEnabledEvent; FValue: DWord; procedure ArrangeButtons; procedure ButtonClick(Sender: TObject); procedure ItemsChange(Sender: TObject); procedure SetButtonCount(Value: Integer); procedure SetColumns(Value: Integer); procedure SetItems(Value: TStrings); procedure UpdateButtons; procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure SetAlignment(const Value: TAlignment); procedure SetButtonVertAlign(const Value: TTextLayout); procedure SetContainer(const Value: TPictureContainer); procedure SetImages(const Value: TImageList); procedure SetEllipsis(const Value: Boolean); procedure SetShadowColor(const Value: TColor); procedure SetShadowOffset(const Value: Integer); function GetChecked(Index: Integer): Boolean; procedure SetChecked(Index: Integer; const Value: Boolean); function GetReadOnly(Index: Integer): Boolean; procedure SetReadOnly(Index: Integer; const Value: Boolean); function GetVersion: string; procedure SetVersion(const Value: string); function GetVersionNr: Integer; procedure SetValue(const Value: DWord); function GetValue: DWord; protected procedure Loaded; override; procedure ReadState(Reader: TReader); override; function CanModify: Boolean; virtual; procedure Notification(AComponent: TComponent; AOperation: TOperation); override; procedure UpdateValue; property Columns: Integer read FColumns write SetColumns default 1; property Items: TStrings read FItems write SetItems; property Value: DWord read GetValue write SetValue; public procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; {$IFDEF DELPHI4_LVL} procedure FlipChildren(AllLevels: Boolean); override; {$ENDIF} procedure PushKey(var Key: Char); procedure PushKeyDown(var Key: Word; Shift: TShiftState); property Checked[Index: Integer]: Boolean read GetChecked write SetChecked; property ReadOnly[Index: Integer]: Boolean read GetReadOnly write SetReadOnly; published property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; property ButtonVertAlign: TTextLayout read fBtnVAlign write SetButtonVertAlign default tlTop; property Ellipsis: Boolean read FEllipsis write SetEllipsis; property Images: TImageList read FImages write SetImages; property PictureContainer: TPictureContainer read FContainer write SetContainer; property ShadowColor: TColor read FShadowColor write SetShadowColor default clSilver; property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 1; property OnIsEnabled: TEnabledEvent read FOnIsEnabled write FOnIsEnabled; property Version: string read GetVersion write SetVersion; end; TAdvOfficeCheckGroup = class(TCustomAdvOfficeCheckGroup) private protected public property Value; published property Align; {$IFDEF DELPHI4_LVL} property Anchors; property BiDiMode; property Constraints; property DragKind; property ParentBiDiMode; {$ENDIF} property Caption; property Color; property Columns; property Ctl3D; property DragCursor; property DragMode; property Enabled; property Font; property Items; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property OnClick; {$IFDEF DELPHI5_LVL} property OnContextPopup; {$ENDIF} property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; {$IFDEF DELPHI4_LVL} property OnEndDock; property OnStartDock; {$ENDIF} property OnStartDrag; end; implementation uses ShellApi, CommCtrl, Math {$IFDEF DELPHI4_LVL} ,Imglist {$ENDIF} ; {$I HTMLENGO.PAS} const BW = 12; procedure PaintFocusRect(ACanvas: TCanvas; R: TRect; Clr: TColor); var LB: TLogBrush; HPen, HOldPen: THandle; begin ACanvas.Pen.Color := Clr; lb.lbColor := ColorToRGB(Clr); lb.lbStyle := bs_Solid; HPen := ExtCreatePen(PS_COSMETIC or PS_ALTERNATE,1, lb, 0, nil); HOldPen := SelectObject(ACanvas.Handle, HPen); MoveToEx(ACanvas.Handle, R.Left, R.Top, nil); LineTo(ACanvas.Handle, R.Right, R.Top); MoveToEx(ACanvas.Handle, R.Right, R.Top, nil); LineTo(ACanvas.Handle, R.Right, R.Bottom); MoveToEx(ACanvas.Handle, R.Right, R.Bottom, nil); LineTo(ACanvas.Handle, R.Left, R.Bottom); MoveToEx(ACanvas.Handle, R.Left, R.Top, nil); LineTo(ACanvas.Handle, R.Left, R.Bottom); DeleteObject(SelectObject(ACanvas.Handle,HOldPen)); end; {$IFNDEF DELPHI4_LVL} function Min(a,b: Integer): Integer; begin if a < b then Result := a else Result := b; end; {$ENDIF} {$IFDEF DELPHI4_LVL} {$IFNDEF TMSDOTNET} function GetFileVersion(FileName:string): Integer; var FileHandle:dword; l: Integer; pvs: PVSFixedFileInfo; lptr: uint; querybuf: array[0..255] of char; buf: PChar; begin Result := -1; StrPCopy(querybuf,FileName); l := GetFileVersionInfoSize(querybuf,FileHandle); if (l>0) then begin GetMem(buf,l); GetFileVersionInfo(querybuf,FileHandle,l,buf); if VerQueryValue(buf,'\',Pointer(pvs),lptr) then begin if (pvs^.dwSignature = $FEEF04BD) then begin Result := pvs^.dwFileVersionMS; end; end; FreeMem(buf); end; end; {$ENDIF} {$ENDIF} function DoThemeDrawing: Boolean; var VerInfo: TOSVersioninfo; FIsWinXP,FIsComCtl6: boolean; i: integer; begin {$IFDEF TMSDOTNET} VerInfo.dwOSVersionInfoSize := Marshal.SizeOf(TypeOf(TOSVersionInfo)); {$ENDIF} {$IFNDEF TMSDOTNET} VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); {$ENDIF} GetVersionEx(verinfo); FIsWinXP := (verinfo.dwMajorVersion > 5) OR ((verinfo.dwMajorVersion = 5) AND (verinfo.dwMinorVersion >= 1)); i := GetFileVersion('COMCTL32.DLL'); i := (i shr 16) and $FF; FIsComCtl6 := (i > 5); Result := FIsComCtl6 and FIsWinXP; end; { TCustomHTMLCheckBox } constructor TCustomAdvOfficeCheckBox.Create(AOwner: TComponent); var VerInfo: TOSVersioninfo; begin inherited Create(AOwner); Width := 120; Height := 20; FUrlColor := clBlue; FBtnVAlign := tlTop; FImageCache := THTMLPictureCache.Create; FCaption := self.ClassName; FShadowOffset := 1; FShadowColor := clGray; {$IFNDEF TMSDOTNET} VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); {$ENDIF} {$IFDEF TMSDOTNET} VerInfo.dwOSVersionInfoSize := Marshal.SizeOf(TypeOf(TOSVersionInfo)); {$ENDIF} GetVersionEx(verinfo); FIsWinXP := (verinfo.dwMajorVersion > 5) OR ((verinfo.dwMajorVersion = 5) AND (verinfo.dwMinorVersion >= 1)); ControlStyle := ControlStyle - [csClickEvents]; FReadOnly := False; {$IFNDEF TMSDOTNET} FBkgBmp := TBitmap.Create; FBkgCache := false; FTransparentCaching := false; {$ENDIF} FDrawBkg := true; end; function TCustomAdvOfficeCheckBox.IsAnchor(x,y:integer):string; var r,hr: TRect; XSize,YSize,HyperLinks,MouseLink: Integer; s:string; Anchor, Stripped, FocusAnchor:string; begin r := Clientrect; s := Caption; Anchor:=''; r.left := r.left + BW + 5; r.top := r.top + 4; Result := ''; if HTMLDrawEx(Canvas,s,r,FImages,x,y,-1,-1,FShadowOffset,True,False,False,False,False,False,not FEllipsis,1.0,FURLColor, clNone,clNone,FShadowColor,Anchor,Stripped,FocusAnchor,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0) then Result := Anchor; end; {$IFNDEF TMSDOTNET} procedure TCustomAdvOfficeCheckBox.DrawParentImage(Control: TControl; Dest: TCanvas); var SaveIndex: Integer; DC: HDC; Position: TPoint; begin with Control do begin if Parent = nil then Exit; DC := Dest.Handle; SaveIndex := SaveDC(DC); GetViewportOrgEx(DC, Position); SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil); IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight); Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(0)); Parent.Perform(WM_PAINT, Integer(DC), Integer(0)); RestoreDC(DC, SaveIndex); end; end; procedure TCustomAdvOfficeCheckBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin inherited; FBkgCache := false; Repaint; end; {$ENDIF} procedure TCustomAdvOfficeCheckBox.DrawCheck; var bmp: TBitmap; BL,BT:Integer; begin BT := 4; //ExtraBW := 4; bmp := TBitmap.Create; if state = cbChecked then begin if Down then bmp.LoadFromResourceName(hinstance,'TMSOFCCD') else if FHot then bmp.LoadFromResourceName(hinstance,'TMSOFCCH') else bmp.LoadFromResourceName(hinstance,'TMSOFCC'); end else begin if Down then bmp.LoadFromResourceName(hinstance,'TMSOFCUD') else if FHot then bmp.LoadFromResourceName(hinstance,'TMSOFCUH') else bmp.LoadFromResourceName(hinstance,'TMSOFCU'); end; bmp.Transparent := true; bmp.TransparentMode := tmAuto; case fBtnVAlign of tlTop: BT := 4; tlCenter: BT := (ClientRect.Bottom - ClientRect.Top) div 2 - (bmp.Height div 2); tlBottom: BT := ClientRect.Bottom - bmp.Height; end; if fAlignment = taRightJustify then BL := ClientRect.Right - bmp.Width - 1 else BL := 0; Canvas.Draw(BL,BT,bmp); bmp.free; end; procedure TCustomAdvOfficeCheckBox.Paint; var R, hr: TRect; a,s,fa,text: string; xsize,ysize: Integer; ExtraBW,HyperLinks,MouseLink: Integer; begin Canvas.Font := Font; if FTransparentCaching then begin if FBkgCache then begin Canvas.Draw(0,0,FBkgBmp) end else begin FBkgBmp.Width := self.Width; FBkgBmp.Height := self.Height; DrawParentImage(Self, FBkgBmp.Canvas); Canvas.Draw(0,0,FBkgBmp); FBkgCache := true; end; end else begin if FDrawBkg then DrawParentImage(Self, Canvas); end; with Canvas do begin Text := Caption; DrawCheck; ExtraBW := 4; R := GetClientRect; if FAlignment = taRightJustify then begin r.Left := 0; r.Right := r.Right - BW - ExtraBW; end else r.left := r.left + BW + ExtraBW; r.top := r.top + 4; if not Enabled then begin OffsetRect(r,1,1); Canvas.Font.Color := clWhite; HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,False,False,False,False,False,False,not FEllipsis,1.0,clWhite, clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0); Canvas.Font.Color := clGray; Offsetrect(r,-1,-1); HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,False,False,False,False,False,False,not FEllipsis,1.0,clGray, clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0); end else HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,False,False,False,False,False,False,not FEllipsis,1.0,FURLColor, clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0); if FFocused then begin r.right := r.left + xsize + 3; r.bottom := r.top + ysize ; //WinProcs.DrawFocusRect(Canvas.Handle,R); PaintFocusRect(Canvas,R,clBlack); end; end; end; procedure TCustomAdvOfficeCheckBox.SetDown(Value:Boolean); begin if FDown <> Value then begin FDown := Value; end; end; procedure TCustomAdvOfficeCheckBox.SetState(Value:TCheckBoxState); var r: TRect; begin if FState <> Value then begin FState := Value; if HandleAllocated and HasParent then begin r := GetClientRect; case Alignment of taLeftJustify: r.Right := 20; taRightJustify: r.Left := r.Right - 20; end; {$IFNDEF TMSDOTNET} InvalidateRect(self.Handle,@r,True); {$ENDIF} {$IFDEF TMSDOTNET} InvalidateRect(self.Handle,r,True); {$ENDIF} end; end; end; function TCustomAdvOfficeCheckBox.GetChecked: Boolean; begin Result := (State = cbChecked); end; procedure TCustomAdvOfficeCheckBox.SetChecked(Value:Boolean); begin if Value then State := cbChecked else State := cbUnchecked; Invalidate; end; procedure TCustomAdvOfficeCheckBox.DoEnter; {$IFNDEF DELPHI9_LVL} var R: TRect; {$ENDIF} begin inherited DoEnter; FFocused := True; {$IFDEF DELPHI9_LVL} Repaint; {$ELSE} R := ClientRect; R.Right := 16; InvalidateRect(self.Handle, @R, true); {$ENDIF} end; procedure TCustomAdvOfficeCheckBox.DoExit; var db: boolean; begin inherited DoExit; FFocused := False; db := FDrawBkg; FDrawBkg := true; Repaint; FDrawBkg := db; end; procedure TCustomAdvOfficeCheckBox.MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); var Anchor:string; R: TRect; begin Anchor := ''; FGotClick := true; if FFocused then begin Anchor := IsAnchor(X,Y); if Anchor <> '' then begin if (Pos('://',Anchor) > 0) or (Pos('mailto:',anchor) > 0) then {$IFNDEF TMSDOTNET} Shellexecute(0,'open',pchar(anchor),nil,nil,SW_NORMAL) {$ENDIF} {$IFDEF TMSDOTNET} Shellexecute(0,'open',anchor,'','',SW_NORMAL) {$ENDIF} else begin if Assigned(FAnchorClick) then FAnchorClick(self,anchor); end; end; end else begin if (self.CanFocus and not (csDesigning in ComponentState)) then begin SetFocus; FFocused := True; end; end; if Anchor = '' then begin inherited MouseDown(Button, Shift, X, Y); MouseCapture := True; Down := True; end; R := ClientRect; R.Right := 16; InvalidateRect(Self.Handle,@R, true); end; procedure TCustomAdvOfficeCheckBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var R: TRect; begin MouseCapture := False; Down := False; if (X >= 0) and (X<=Width) and (Y>=0) and (Y<=Height) and FFocused and FGotClick then begin ClicksDisabled := True; Toggle; ClicksDisabled := False; Click; end; inherited MouseUp(Button, Shift, X, Y); R := ClientRect; R.Right := 16; InvalidateRect(Self.Handle,@R, true); FGotClick := false; end; procedure TCustomAdvOfficeCheckBox.MouseMove(Shift: TShiftState;X, Y: Integer); var Anchor:string; begin if MouseCapture then Down := (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height); if fFocused then Anchor := IsAnchor(x,y) else Anchor := ''; if Anchor <> '' then begin if (self.Cursor = crDefault) or (FAnchor <> Anchor) then begin FAnchor := Anchor; self.Cursor := crHandPoint; if Assigned(FAnchorEnter) then FAnchorEnter(self,Anchor); end; end else begin if self.Cursor = crHandPoint then begin self.Cursor := FOldCursor; if Assigned(FAnchorExit) then FAnchorExit(self,Anchor); end; end; inherited MouseMove(Shift,X,Y); end; procedure TCustomAdvOfficeCheckBox.KeyDown(var Key:Word;Shift:TShiftSTate); begin if (Key=vk_return) and (fReturnIsTab) then begin Key := vk_tab; PostMessage(self.Handle,wm_keydown,VK_TAB,0); end; if Key = vk_Space then Down := True; inherited KeyDown(Key,Shift); end; procedure TCustomAdvOfficeCheckBox.KeyUp(var Key:Word;Shift:TShiftSTate); begin if Key = vk_Space then begin Down := False; Toggle; Click; end; end; procedure TCustomAdvOfficeCheckBox.SetImages(const Value: TImageList); begin FImages := Value; Invalidate; end; procedure TCustomAdvOfficeCheckBox.SetURLColor(const Value: TColor); begin if FURLColor <> Value then begin FURLColor := Value; Invalidate; end; end; procedure TCustomAdvOfficeCheckBox.Notification(AComponent: TComponent; AOperation: TOperation); begin inherited; if (AOperation = opRemove) and (AComponent = FImages) then FImages:=nil; if (AOperation = opRemove) and (AComponent = FContainer) then FContainer := nil; end; procedure TCustomAdvOfficeCheckBox.CMEnabledChanged(var Message: TMessage); begin inherited; Invalidate; end; procedure TCustomAdvOfficeCheckBox.SetButtonVertAlign(const Value: TTextLayout); begin if Value <> FBtnVAlign then begin FBtnVAlign := Value; Invalidate; end; end; procedure TCustomAdvOfficeCheckBox.SetAlignment(const Value: TLeftRight); begin if FAlignment <> Value then begin FAlignment := Value; Invalidate; end; end; destructor TCustomAdvOfficeCheckBox.Destroy; begin {$IFNDEF TMSDOTNET} FBkgBmp.Free; {$ENDIF} FImageCache.Free; inherited; end; procedure TCustomAdvOfficeCheckBox.SetEllipsis(const Value: Boolean); begin if FEllipsis <> Value then begin FEllipsis := Value; Invalidate end; end; procedure TCustomAdvOfficeCheckBox.SetCaption(Value: string); begin {$IFNDEF TMSDOTNET} SetWindowText(Handle,pchar(Value)); {$ENDIF} {$IFDEF TMSDOTNET} SetWindowText(Handle,Value); {$ENDIF} FCaption := Value; Invalidate; end; procedure TCustomAdvOfficeCheckBox.Toggle; begin if not FReadOnly then Checked := not Checked; end; procedure TCustomAdvOfficeCheckBox.WMEraseBkGnd(var Message: TMessage); begin Message.Result := 1 end; procedure TCustomAdvOfficeCheckBox.CMDialogChar(var Message: TCMDialogChar); begin with Message do begin if IsAccel(CharCode, FCaption) and CanFocus then begin Toggle; if Assigned(OnClick) then OnClick(Self); if TabStop then if (self.CanFocus and not (csDesigning in ComponentState)) then SetFocus; Result := 1; end else inherited; end; end; procedure TCustomAdvOfficeCheckBox.SetContainer(const Value: TPictureContainer); begin FContainer := Value; Invalidate; end; procedure TCustomAdvOfficeCheckBox.SetShadowColor(const Value: TColor); begin if FShadowColor <> Value then begin FShadowColor := Value; Invalidate; end; end; procedure TCustomAdvOfficeCheckBox.SetShadowOffset(const Value: Integer); begin if FShadowOffset <> Value then begin FShadowOffset := Value; Invalidate; end; end; procedure TCustomAdvOfficeCheckBox.CMMouseEnter(var Message: TMessage); begin FHot := True; DrawCheck; inherited; end; procedure TCustomAdvOfficeCheckBox.CMMouseLeave(var Message: TMessage); begin FHot := False; DrawCheck; inherited; end; procedure TCustomAdvOfficeCheckBox.Loaded; begin inherited; FOldCursor := Cursor; end; function TCustomAdvOfficeCheckBox.GetVersion: string; var vn: Integer; begin vn := GetVersionNr; Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn))); end; function TCustomAdvOfficeCheckBox.GetVersionNr: Integer; begin Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER)); end; procedure TCustomAdvOfficeCheckBox.SetVersion(const Value: string); begin end; { THTMLRadioButton } constructor TAdvOfficeRadioButton.Create(AOwner: TComponent); var VerInfo: TOSVersionInfo; begin inherited Create(AOwner); Width := 135; Height := 20; FURLColor := clBlue; FBtnVAlign := tlTop; FImageCache := THTMLPictureCache.Create; FCaption := self.ClassName; FShadowOffset := 1; FShadowColor := clGray; {$IFNDEF TMSDOTNET} VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); {$ENDIF} {$IFDEF TMSDOTNET} VerInfo.dwOSVersionInfoSize := Marshal.SizeOf(TypeOf(TOSVersionInfo)); {$ENDIF} GetVersionEx(verinfo); FIsWinXP := (verinfo.dwMajorVersion > 5) OR ((verinfo.dwMajorVersion = 5) AND (verinfo.dwMinorVersion >= 1)); {$IFNDEF TMSDOTNET} FBkgBmp := TBitmap.Create; FBkgCache := false; FTransparentCaching := false; {$ENDIF} FDrawBkg := true; end; function TAdvOfficeRadioButton.IsAnchor(x,y:integer):string; var r,hr: TRect; XSize,YSize,HyperLinks,MouseLink: Integer; s: string; Anchor,Stripped,FocusAnchor: string; begin r := Clientrect; s := Caption; Anchor := ''; r.left := r.left + BW + 5; r.top := r.top + 4; Result := ''; if HTMLDrawEx(Canvas,s,r,FImages,x,y,-1,-1,FShadowOffset,True,False,False,False,False,False,not FEllipsis,1.0,FURLColor, clNone,clNone,FShadowColor,Anchor,Stripped,FocusAnchor,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0) then Result := Anchor; end; procedure TAdvOfficeRadioButton.DrawParentImage(Control: TControl; Dest: TCanvas); var SaveIndex: Integer; DC: HDC; Position: TPoint; begin with Control do begin if Parent = nil then Exit; DC := Dest.Handle; SaveIndex := SaveDC(DC); GetViewportOrgEx(DC, Position); SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil); IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight); Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(0)); Parent.Perform(WM_PAINT, Integer(DC), Integer(0)); RestoreDC(DC, SaveIndex); end; end; procedure TAdvOfficeRadioButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin inherited; begin FBkgCache := false; Repaint; end; end; procedure TAdvOfficeRadioButton.DrawRadio; var bmp: TBitmap; BT, BL: integer; begin BT := 4; bmp := TBitmap.Create; if (Checked) then begin if Down then bmp.LoadFromResourceName(hinstance,'TMSOFRCD') else if FHot then bmp.LoadFromResourceName(hinstance,'TMSOFRCH') else bmp.LoadFromResourceName(hinstance,'TMSOFRC'); end else begin if Down then bmp.LoadFromResourceName(hinstance,'TMSOFRUD') else if FHot then bmp.LoadFromResourceName(hinstance,'TMSOFRUH') else bmp.LoadFromResourceName(hinstance,'TMSOFRU'); end; bmp.Transparent:=true; bmp.TransparentMode :=tmAuto; case FBtnVAlign of tlTop: BT := 4; tlCenter: BT := (ClientRect.Bottom-ClientRect.Top) div 2 - (bmp.Height div 2); tlBottom: BT := ClientRect.Bottom - bmp.Height - 2; end; if fAlignment = taRightJustify then BL := ClientRect.Right - bmp.Width - 1 else BL := 0; Canvas.Draw(BL,BT,bmp); bmp.Free; end; procedure TAdvOfficeRadioButton.Paint; var BR:Integer; R,hr: TRect; a,s,fa,text: string; XSize,YSize,HyperLinks,MouseLink: Integer; begin Canvas.Font := Font; Text := Caption; if FTransparentCaching then begin if FBkgCache then begin Self.Canvas.Draw(0,0,FBkgBmp) end else begin FBkgBmp.Width := self.Width; FBkgBmp.Height := self.Height; //FBkgBmp.PixelFormat := pf32bit; DrawParentImage(Self, FBkgBmp.Canvas); Self.Canvas.Draw(0,0,FBkgBmp); FBkgCache := true; end; end else begin if DrawBkg then DrawParentImage(Self, self.Canvas); end; with Canvas do begin BR := 13; DrawRadio; r := GetClientRect; if FAlignment = taRightJustify then begin r.Left := 0; r.Right := r.Right - BR - 5; end else r.Left := r.Left + BR + 5; r.Top := r.Top + 4; if not Enabled then begin OffsetRect(R,1,1); Canvas.Font.Color := clWhite; HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,False,False,False,False,False,False,not FEllipsis,1.0,clGray, clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0); Canvas.Font.Color := clGray; Offsetrect(R,-1,-1); HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,False,False,False,False,False,False,not FEllipsis,1.0,clWhite, clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0); end else begin Canvas.Font.Color := Font.Color; HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,False,False,False,False,False,False,not FEllipsis,1.0,FURLColor, clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0); end; if FFocused then begin r.Right := r.Left + xsize + 3; r.Bottom := r.Top + ysize {+ 1}; PaintFocusRect(Canvas,R,clBlack); end; end; end; procedure TAdvOfficeRadioButton.SetURLColor(const Value: TColor); begin FURLColor := Value; Invalidate; end; procedure TAdvOfficeRadioButton.SetDown(Value:Boolean); begin if FDown<>Value then begin FDown := Value; end; end; procedure TAdvOfficeRadioButton.TurnSiblingsOff; var i:Integer; Sibling: TAdvOfficeRadioButton; begin if (Parent <> nil) then for i:=0 to Parent.ControlCount-1 do if Parent.Controls[i] is TAdvOfficeRadioButton then begin Sibling := TAdvOfficeRadioButton(Parent.Controls[i]); if (Sibling <> Self) and (Sibling.GroupIndex = GroupIndex) then Sibling.SetChecked(False); end; end; procedure TAdvOfficeRadioButton.SetChecked(Value: Boolean); var r: TRect; begin if FChecked <> Value then begin TabStop := Value; FChecked := Value; if Value then begin TurnSiblingsOff; //if not FClicksDisabled then //DoClick; end; if HandleAllocated and HasParent then begin R := ClientRect; R.Right := 16; InvalidateRect(self.Handle, @r, true); end; // Invalidate; end; end; procedure TAdvOfficeRadioButton.DoClick; begin if Assigned(OnClick) then OnClick(Self); end; procedure TAdvOfficeRadioButton.DoEnter; {$IFNDEF DELPHI9_LVL} var R: TRect; {$ENDIF} begin inherited DoEnter; FFocused := True; Checked := true; {$IFDEF DELPHI9_LVL} Repaint; {$ELSE} R := ClientRect; R.Right := 16; InvalidateRect(self.Handle, @R, true); {$ENDIF} end; procedure TAdvOfficeRadioButton.DoExit; var db: boolean; begin inherited DoExit; FFocused := False; db := FDrawBkg; FDrawBkg := true; Repaint; FDrawBkg := db; end; procedure TAdvOfficeRadioButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Anchor:string; R: TRect; begin Anchor := ''; FGotClick := true; if FFocused then begin Anchor := IsAnchor(X,Y); if Anchor <> '' then begin if (Pos('://',Anchor)>0) or (Pos('mailto:',Anchor)>0) then {$IFNDEF TMSDOTNET} ShellExecute(0,'open',PChar(Anchor),nil,nil,SW_NORMAL) {$ENDIF} {$IFDEF TMSDOTNET} ShellExecute(0,'open',Anchor,'','',SW_NORMAL) {$ENDIF} else begin if Assigned(FAnchorClick) then FAnchorClick(self,anchor); end; end; end else begin if (self.CanFocus and not (csDesigning in ComponentState)) then begin SetFocus; FFocused := True; end; end; if Anchor = '' then begin inherited MouseDown(Button, Shift, X, Y); MouseCapture := True; Down := True; end; R := ClientRect; R.Right := 16; InvalidateRect(self.Handle, @r, true); end; procedure TAdvOfficeRadioButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var R: TRect; begin MouseCapture := False; Down := False; if (X >= 0) and (X <= Width) and (Y >= 0) and (Y <= Height) and not Checked and FGotClick then begin Checked := true; end; inherited MouseUp(Button, Shift, X, Y); DoClick; R := ClientRect; R.Right := 16; InvalidateRect(self.Handle, @r, true); FGotClick := false; end; procedure TAdvOfficeRadioButton.MouseMove(Shift: TShiftState;X, Y: Integer); var Anchor:string; begin if MouseCapture then Down := (X>=0) and (X<=Width) and (Y>=0) and (Y<=Height); if FFocused then Anchor := IsAnchor(x,y) else Anchor := ''; if Anchor <> '' then begin if (self.Cursor = crDefault) or (fAnchor <> Anchor) then begin FAnchor := Anchor; self.Cursor := crHandPoint; if Assigned(FAnchorEnter) then FAnchorEnter(self,anchor); end; end else begin if self.Cursor = crHandPoint then begin self.Cursor := FOldCursor; if Assigned(FAnchorExit) then FAnchorExit(self,anchor); end; end; inherited MouseMove(Shift,X,Y); end; procedure TAdvOfficeRadioButton.KeyDown(var Key:Word;Shift:TShiftSTate); begin if (Key = vk_return) and (FReturnIsTab) then begin Key := vk_tab; PostMessage(self.Handle,wm_keydown,VK_TAB,0); end; if Key = VK_SPACE then Down := True; inherited KeyDown(Key,Shift); end; procedure TAdvOfficeRadioButton.KeyUp(var Key:Word;Shift:TShiftSTate); begin if Key = VK_SPACE then begin Down := False; if not Checked then Checked := True; end; end; procedure TAdvOfficeRadioButton.SetImages(const Value: TImageList); begin FImages := Value; Invalidate; end; procedure TAdvOfficeRadioButton.Notification(AComponent: TComponent; AOperation: TOperation); begin inherited; if (AOperation = opRemove) and (AComponent = FImages) then FImages := nil; if (AOperation = opRemove) and (AComponent = FContainer) then FContainer := nil; end; procedure TAdvOfficeRadioButton.CMEnabledChanged(var Message: TMessage); begin inherited; Invalidate; end; procedure TAdvOfficeRadioButton.SetButtonVertAlign(const Value: TTextLayout); begin if Value <> FBtnVAlign then begin FBtnVAlign := Value; Invalidate; end; end; procedure TAdvOfficeRadioButton.SetAlignment(const Value: TLeftRight); begin if FAlignment <> Value then begin FAlignment := Value; Invalidate; end; end; destructor TAdvOfficeRadioButton.Destroy; begin {$IFNDEF TMSDOTNET} FBkgBmp.Free; {$ENDIF} FImageCache.Free; inherited; end; procedure TAdvOfficeRadioButton.SetEllipsis(const Value: Boolean); begin if FEllipsis <> Value then begin FEllipsis := Value; Invalidate; end; end; procedure TAdvOfficeRadioButton.SetCaption(const Value: string); begin inherited Caption := Value; FCaption := Value; Invalidate; end; procedure TAdvOfficeRadioButton.Click; begin // inherited; end; procedure TAdvOfficeRadioButton.CMDialogChar(var Message: TCMDialogChar); begin with Message do if IsAccel(CharCode, FCaption) and CanFocus then begin Checked := True; if TabStop then if (self.CanFocus and not (csDesigning in ComponentState)) then SetFocus; Result := 1; end else inherited; end; procedure TAdvOfficeRadioButton.SetContainer(const Value: TPictureContainer); begin FContainer := Value; Invalidate; end; procedure TAdvOfficeRadioButton.SetShadowColor(const Value: TColor); begin if FShadowColor <> Value then begin FShadowColor := Value; Invalidate; end; end; procedure TAdvOfficeRadioButton.SetShadowOffset(const Value: Integer); begin if FShadowOffset <> Value then begin FShadowOffset := Value; Invalidate; end; end; procedure TAdvOfficeRadioButton.CMMouseEnter(var Message: TMessage); begin FHot := True; DrawRadio; inherited; end; procedure TAdvOfficeRadioButton.CMMouseLeave(var Message: TMessage); begin FHot := False; DrawRadio; inherited; end; procedure TAdvOfficeRadioButton.WMEraseBkGnd(var Message: TMessage); begin Message.Result := 1 end; procedure TAdvOfficeRadioButton.WMLButtonDown(var Message:TWMLButtonDown); begin FClicksDisabled := True; if (self.CanFocus and not (csDesigning in ComponentState)) then SetFocus; FClicksDisabled := False; inherited; end; procedure TAdvOfficeRadioButton.Loaded; begin inherited; FOldCursor := Cursor; end; function TAdvOfficeRadioButton.GetVersion: string; var vn: Integer; begin vn := GetVersionNr; Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn))); end; function TAdvOfficeRadioButton.GetVersionNr: Integer; begin Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER)); end; procedure TAdvOfficeRadioButton.SetVersion(const Value: string); begin end; { TAdvGroupButton } type TAdvGroupButton = class(TAdvOfficeRadioButton) private FInClick: Boolean; procedure CNCommand(var Message: TWMCommand); message CN_COMMAND; protected procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; public constructor InternalCreate(RadioGroup: TCustomAdvOfficeRadioGroup); destructor Destroy; override; end; constructor TAdvGroupButton.InternalCreate(RadioGroup: TCustomAdvOfficeRadioGroup); begin inherited Create(RadioGroup); RadioGroup.FButtons.Add(Self); Visible := False; Enabled := RadioGroup.Enabled; ParentShowHint := False; OnClick := RadioGroup.ButtonClick; Parent := RadioGroup; end; destructor TAdvGroupButton.Destroy; begin TCustomAdvOfficeRadioGroup(Owner).FButtons.Remove(Self); inherited Destroy; end; procedure TAdvGroupButton.CNCommand(var Message: TWMCommand); begin if not FInClick then begin FInClick := True; try if ((Message.NotifyCode = BN_CLICKED) or (Message.NotifyCode = BN_DOUBLECLICKED)) and TCustomAdvOfficeRadioGroup(Parent).CanModify then inherited; except Application.HandleException(Self); end; FInClick := False; end; end; procedure TAdvGroupButton.KeyPress(var Key: Char); begin inherited KeyPress(Key); TCustomAdvOfficeRadioGroup(Parent).PushKey(Key); if (Key = #8) or (Key = ' ') then begin if not TCustomAdvOfficeRadioGroup(Parent).CanModify then Key := #0; end; end; procedure TAdvGroupButton.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); TCustomAdvOfficeRadioGroup(Parent).PushKeyDown(Key, Shift); end; { TCustomAdvOfficeRadioGroup } constructor TCustomAdvOfficeRadioGroup.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csSetCaption, csDoubleClicks]; FButtons := TList.Create; FItems := TStringList.Create; TStringList(FItems).OnChange := ItemsChange; FItemIndex := -1; FColumns := 1; FAlignment := taLeftJustify; FBtnVAlign := tlTop; ShadowOffset := 1; ShadowColor := clSilver; FIsReadOnly := false; end; destructor TCustomAdvOfficeRadioGroup.Destroy; begin SetButtonCount(0); TStringList(FItems).OnChange := nil; FItems.Free; FButtons.Free; inherited Destroy; end; procedure TCustomAdvOfficeRadioGroup.PushKey(var Key: Char); begin KeyPress(Key); end; procedure TCustomAdvOfficeRadioGroup.PushKeyDown(var Key: Word; Shift: TShiftState); begin KeyDown(Key,Shift); end; procedure TCustomAdvOfficeRadioGroup.FlipChildren(AllLevels: Boolean); begin { The radio buttons are flipped using BiDiMode } end; procedure TCustomAdvOfficeRadioGroup.ArrangeButtons; var ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer; DC: HDC; SaveFont: HFont; Metrics: TTextMetric; DeferHandle: THandle; ALeft: Integer; RadioEnable: Boolean; begin if (csLoading in ComponentState) then Exit; if not HandleAllocated then Exit; if (FButtons.Count <> 0) and not FReading then begin DC := GetDC(0); SaveFont := SelectObject(DC, Font.Handle); GetTextMetrics(DC, Metrics); SelectObject(DC, SaveFont); ReleaseDC(0, DC); ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns; ButtonWidth := (Width - 10) div FColumns; I := Height - Metrics.tmHeight - 5; ButtonHeight := I div ButtonsPerCol; TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2; DeferHandle := BeginDeferWindowPos(FButtons.Count); try for I := 0 to FButtons.Count - 1 do with TAdvGroupButton(FButtons[I]) do begin {$IFDEF DELPHI4_LVL} BiDiMode := Self.BiDiMode; {$ENDIF} DrawBkg := false; Alignment := Self.Alignment; ButtonVertAlign := Self.ButtonVertAlign; Images := Self.Images; PictureContainer := Self.PictureContainer; Ellipsis := Self.Ellipsis; ShadowOffset := Self.ShadowOffset; ShadowColor := Self.ShadowColor; RadioEnable := Self.Enabled and Enabled and not FIsReadOnly; if Assigned(FOnIsEnabled) then FOnIsEnabled(Self,I,RadioEnable); Enabled := RadioEnable; ALeft := (I div ButtonsPerCol) * ButtonWidth + 8; {$IFDEF DELPHI4_LVL} if UseRightToLeftAlignment then ALeft := Self.ClientWidth - ALeft - ButtonWidth; {$ENDIF} DeferHandle := DeferWindowPos(DeferHandle, Handle, 0, ALeft, (I mod ButtonsPerCol) * ButtonHeight + TopMargin, ButtonWidth, ButtonHeight, SWP_NOZORDER or SWP_NOACTIVATE); // Left := ALeft; // Top := (I mod ButtonsPerCol) * ButtonHeight + TopMargin; Visible := True; end; finally EndDeferWindowPos(DeferHandle); end; end; end; procedure TCustomAdvOfficeRadioGroup.ButtonClick(Sender: TObject); begin if not FUpdating then begin FItemIndex := FButtons.IndexOf(Sender); Changed; Click; end; end; procedure TCustomAdvOfficeRadioGroup.ItemsChange(Sender: TObject); begin if not FReading then begin if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1; UpdateButtons; end; end; procedure TCustomAdvOfficeRadioGroup.Loaded; begin inherited Loaded; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.ReadState(Reader: TReader); begin FReading := True; inherited ReadState(Reader); FReading := False; UpdateButtons; end; procedure TCustomAdvOfficeRadioGroup.SetButtonCount(Value: Integer); begin while FButtons.Count < Value do TAdvGroupButton.InternalCreate(Self); while FButtons.Count > Value do TAdvGroupButton(FButtons.Last).Free; end; procedure TCustomAdvOfficeRadioGroup.SetColumns(Value: Integer); begin if Value < 1 then Value := 1; if Value > 16 then Value := 16; if FColumns <> Value then begin FColumns := Value; ArrangeButtons; Invalidate; end; end; procedure TCustomAdvOfficeRadioGroup.SetItemIndex(Value: Integer); begin if FReading then FItemIndex := Value else begin if Value < -1 then Value := -1; if Value >= FButtons.Count then Value := FButtons.Count - 1; if FItemIndex <> Value then begin if FItemIndex >= 0 then TAdvGroupButton(FButtons[FItemIndex]).Checked := False; FItemIndex := Value; if FItemIndex >= 0 then TAdvGroupButton(FButtons[FItemIndex]).Checked := True; end; end; end; procedure TCustomAdvOfficeRadioGroup.SetItems(Value: TStrings); begin FItems.Assign(Value); end; procedure TCustomAdvOfficeRadioGroup.UpdateButtons; var I: Integer; begin SetButtonCount(FItems.Count); for I := 0 to FButtons.Count - 1 do TAdvGroupButton(FButtons[I]).Caption := FItems[I]; if FItemIndex >= 0 then begin FUpdating := True; TAdvGroupButton(FButtons[FItemIndex]).Checked := True; FUpdating := False; end; ArrangeButtons; Invalidate; end; procedure TCustomAdvOfficeRadioGroup.CMEnabledChanged(var Message: TMessage); var I: Integer; begin inherited; for I := 0 to FButtons.Count - 1 do TAdvGroupButton(FButtons[I]).Enabled := Enabled; end; procedure TCustomAdvOfficeRadioGroup.CMFontChanged(var Message: TMessage); begin inherited; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.WMSize(var Message: TWMSize); begin inherited; ArrangeButtons; end; function TCustomAdvOfficeRadioGroup.CanModify: Boolean; begin Result := True; end; procedure TCustomAdvOfficeRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent); begin end; procedure TCustomAdvOfficeRadioGroup.SetAlignment(const Value: TAlignment); begin FAlignment := Value; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.SetButtonVertAlign( const Value: TTextLayout); begin fBtnVAlign := Value; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.SetContainer( const Value: TPictureContainer); begin FContainer := Value; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.SetImages(const Value: TImageList); begin inherited Images := Value; FImages := Value; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.Notification(AComponent: TComponent; AOperation: TOperation); begin inherited; if (AOperation = opRemove) and (AComponent = FImages) then FImages:=nil; if (AOperation = opRemove) and (AComponent = FContainer) then FContainer := nil; end; procedure TCustomAdvOfficeRadioGroup.SetEllipsis(const Value: Boolean); begin FEllipsis := Value; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.SetShadowColor(const Value: TColor); begin FShadowColor := Value; ArrangeButtons; end; procedure TCustomAdvOfficeRadioGroup.SetShadowOffset(const Value: Integer); begin FShadowOffset := Value; ArrangeButtons; end; function TCustomAdvOfficeRadioGroup.GetVersion: string; var vn: Integer; begin vn := GetVersionNr; Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn))); end; function TCustomAdvOfficeRadioGroup.GetVersionNr: Integer; begin Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER)); end; procedure TCustomAdvOfficeRadioGroup.SetVersion(const Value: string); begin end; { TGroupCheck } type TGroupCheck = class(TAdvOfficeCheckBox) private FInClick: Boolean; procedure CNCommand(var Message: TWMCommand); message CN_COMMAND; protected procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; public constructor InternalCreate(CheckGroup: TCustomAdvOfficeCheckGroup); destructor Destroy; override; end; constructor TGroupCheck.InternalCreate(CheckGroup: TCustomAdvOfficeCheckGroup); begin inherited Create(CheckGroup); CheckGroup.FButtons.Add(Self); Visible := False; Enabled := CheckGroup.Enabled; ParentShowHint := False; OnClick := CheckGroup.ButtonClick; Parent := CheckGroup; end; destructor TGroupCheck.Destroy; begin TCustomAdvOfficeCheckGroup(Owner).FButtons.Remove(Self); inherited Destroy; end; procedure TGroupCheck.CNCommand(var Message: TWMCommand); begin if not FInClick then begin FInClick := True; try if ((Message.NotifyCode = BN_CLICKED) or (Message.NotifyCode = BN_DOUBLECLICKED)) and TCustomAdvOfficeCheckGroup(Parent).CanModify then inherited; except Application.HandleException(Self); end; FInClick := False; end; end; procedure TGroupCheck.KeyPress(var Key: Char); begin inherited KeyPress(Key); TCustomAdvOfficeCheckGroup(Parent).PushKey(Key); if (Key = #8) or (Key = ' ') then begin if not TCustomAdvOfficeCheckGroup(Parent).CanModify then Key := #0; end; end; procedure TGroupCheck.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); TCustomAdvOfficeCheckGroup(Parent).PushKeyDown(Key, Shift); end; { TCustomAdvOfficeCheckGroup } constructor TCustomAdvOfficeCheckGroup.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csSetCaption, csDoubleClicks]; FButtons := TList.Create; FItems := TStringList.Create; TStringList(FItems).OnChange := ItemsChange; FColumns := 1; FAlignment := taLeftJustify; FBtnVAlign := tlTop; ShadowOffset := 1; ShadowColor := clSilver; FValue := 0; end; destructor TCustomAdvOfficeCheckGroup.Destroy; begin SetButtonCount(0); TStringList(FItems).OnChange := nil; FItems.Free; FButtons.Free; inherited Destroy; end; procedure TCustomAdvOfficeCheckGroup.PushKey(var Key: Char); begin KeyPress(Key); end; procedure TCustomAdvOfficeCheckGroup.PushKeyDown(var Key: Word; Shift: TShiftState); begin KeyDown(Key,Shift); end; {$IFDEF DELPHI4_LVL} procedure TCustomAdvOfficeCheckGroup.FlipChildren(AllLevels: Boolean); begin { The radio buttons are flipped using BiDiMode } end; {$ENDIF} procedure TCustomAdvOfficeCheckGroup.ArrangeButtons; var ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer; DC: HDC; SaveFont: HFont; Metrics: TTextMetric; DeferHandle: THandle; ALeft: Integer; RadioEnable: Boolean; begin if (FButtons.Count <> 0) and not FReading then begin DC := GetDC(0); SaveFont := SelectObject(DC, Font.Handle); GetTextMetrics(DC, Metrics); SelectObject(DC, SaveFont); ReleaseDC(0, DC); ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns; ButtonWidth := (Width - 10) div FColumns; I := Height - Metrics.tmHeight - 5; ButtonHeight := I div ButtonsPerCol; TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2; DeferHandle := BeginDeferWindowPos(FButtons.Count); try for I := 0 to FButtons.Count - 1 do with TGroupCheck(FButtons[I]) do begin {$IFDEF DELPHI4_LVL} BiDiMode := Self.BiDiMode; {$ENDIF} DrawBkg := false; Alignment := Self.Alignment; ButtonVertAlign := Self.ButtonVertAlign; Images := Self.Images; PictureContainer := Self.PictureContainer; Ellipsis := Self.Ellipsis; ShadowOffset := Self.ShadowOffset; ShadowColor := Self.ShadowColor; RadioEnable := self.Enabled; if Assigned(FOnIsEnabled) then FOnIsEnabled(Self,I,RadioEnable); Enabled := RadioEnable; ALeft := (I div ButtonsPerCol) * ButtonWidth + 8; {$IFDEF DELPHI4_LVL} if UseRightToLeftAlignment then ALeft := Self.ClientWidth - ALeft - ButtonWidth; {$ENDIF} DeferHandle := DeferWindowPos(DeferHandle, Handle, 0, ALeft, (I mod ButtonsPerCol) * ButtonHeight + TopMargin, ButtonWidth, ButtonHeight, SWP_NOZORDER or SWP_NOACTIVATE); Visible := True; end; finally EndDeferWindowPos(DeferHandle); end; end; end; procedure TCustomAdvOfficeCheckGroup.ButtonClick(Sender: TObject); begin if not FUpdating then begin Changed; Click; end; UpdateValue; end; procedure TCustomAdvOfficeCheckGroup.ItemsChange(Sender: TObject); begin if not FReading then begin UpdateButtons; end; end; procedure TCustomAdvOfficeCheckGroup.Loaded; begin inherited Loaded; ArrangeButtons; Value := Value; end; procedure TCustomAdvOfficeCheckGroup.ReadState(Reader: TReader); begin FReading := True; inherited ReadState(Reader); FReading := False; UpdateButtons; end; procedure TCustomAdvOfficeCheckGroup.SetButtonCount(Value: Integer); begin while FButtons.Count < Value do TGroupCheck.InternalCreate(Self); while FButtons.Count > Value do TGroupCheck(FButtons.Last).Free; end; procedure TCustomAdvOfficeCheckGroup.SetColumns(Value: Integer); begin if Value < 1 then Value := 1; if Value > 16 then Value := 16; if FColumns <> Value then begin FColumns := Value; ArrangeButtons; Invalidate; end; end; procedure TCustomAdvOfficeCheckGroup.SetItems(Value: TStrings); begin FItems.Assign(Value); end; procedure TCustomAdvOfficeCheckGroup.UpdateButtons; var I: Integer; begin SetButtonCount(FItems.Count); for I := 0 to FButtons.Count - 1 do TGroupCheck(FButtons[I]).Caption := FItems[I]; ArrangeButtons; Invalidate; end; procedure TCustomAdvOfficeCheckGroup.CMEnabledChanged(var Message: TMessage); var I: Integer; begin inherited; for I := 0 to FButtons.Count - 1 do TGroupCheck(FButtons[I]).Enabled := Enabled; end; procedure TCustomAdvOfficeCheckGroup.CMFontChanged(var Message: TMessage); begin inherited; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.WMSize(var Message: TWMSize); begin inherited; ArrangeButtons; end; function TCustomAdvOfficeCheckGroup.CanModify: Boolean; begin Result := True; end; procedure TCustomAdvOfficeCheckGroup.GetChildren(Proc: TGetChildProc; Root: TComponent); begin end; procedure TCustomAdvOfficeCheckGroup.SetAlignment(const Value: TAlignment); begin FAlignment := Value; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.SetButtonVertAlign( const Value: TTextLayout); begin fBtnVAlign := Value; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.SetContainer( const Value: TPictureContainer); begin FContainer := Value; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.SetImages(const Value: TImageList); begin inherited Images := Value; FImages := Value; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.Notification(AComponent: TComponent; AOperation: TOperation); begin inherited; if (AOperation = opRemove) and (AComponent = FImages) then FImages:=nil; if (AOperation = opRemove) and (AComponent = FContainer) then FContainer := nil; end; procedure TCustomAdvOfficeCheckGroup.SetEllipsis(const Value: Boolean); begin FEllipsis := Value; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.SetShadowColor(const Value: TColor); begin FShadowColor := Value; ArrangeButtons; end; procedure TCustomAdvOfficeCheckGroup.SetShadowOffset(const Value: Integer); begin FShadowOffset := Value; ArrangeButtons; end; function TCustomAdvOfficeCheckGroup.GetChecked(Index: Integer): Boolean; begin if (Index < FButtons.Count) and (Index >= 0) then Result := TGroupCheck(FButtons[Index]).Checked else raise Exception.Create('Invalid checkbox index'); end; procedure TCustomAdvOfficeCheckGroup.SetChecked(Index: Integer; const Value: Boolean); begin if (Index < FButtons.Count) and (Index >= 0) then TGroupCheck(FButtons[Index]).Checked := Value; end; function TCustomAdvOfficeCheckGroup.GetReadOnly(Index: Integer): Boolean; begin if (Index < FButtons.Count) and (Index >= 0) then Result := not TGroupCheck(FButtons[Index]).Enabled else raise Exception.Create('Invalid checkbox index'); end; procedure TCustomAdvOfficeCheckGroup.SetReadOnly(Index: Integer; const Value: Boolean); begin if (Index < FButtons.Count) and (Index >= 0) then TGroupCheck(FButtons[Index]).Enabled := not Value; end; procedure TCustomAdvOfficeCheckGroup.UpdateValue; var i, j: Integer; BitMask: DWord; begin FValue := Value; j := Min(FButtons.Count, sizeof(DWord) * 8); BitMask := 1; FValue := 0; for i := 0 to j - 1 do begin if TGroupCheck(FButtons[i]).Checked then begin FValue := FValue or BitMask; end; BitMask := BitMask * 2; end; end; function TCustomAdvOfficeCheckGroup.GetValue: DWord; begin Result := FValue; end; procedure TCustomAdvOfficeCheckGroup.SetValue(const Value: DWord); var i, j: Integer; BitMask: Integer; begin //if (FValue <> Value) then begin FValue := Value; j := Min(FButtons.Count, sizeof(DWord) * 8); BitMask := 1; for i := 0 to j - 1 do begin TGroupCheck(FButtons[i]).Checked := ((FValue And BitMask) > 0); BitMask := BitMask * 2; end; end; end; function TCustomAdvOfficeCheckGroup.GetVersion: string; var vn: Integer; begin vn := GetVersionNr; Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn))); end; function TCustomAdvOfficeCheckGroup.GetVersionNr: Integer; begin Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER)); end; procedure TCustomAdvOfficeCheckGroup.SetVersion(const Value: string); begin end; {$IFDEF FREEWARE} {$I TRIAL.INC} {$ENDIF} end.