diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/AdvGroupBox.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/AdvGroupBox.dcu
deleted file mode 100644
index 77eaea9..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/AdvGroupBox.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/AdvOfficeButtons.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/AdvOfficeButtons.dcu
deleted file mode 100644
index 71e9032..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/AdvOfficeButtons.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/PictureContainer.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/PictureContainer.dcu
index e5b1989..1e65a42 100644
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/PictureContainer.dcu and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/PictureContainer.dcu differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/SpanishContst.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/SpanishContst.dcu
new file mode 100644
index 0000000..7b82f45
Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/SpanishContst.dcu differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialog.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialog.dcu
index dd77551..654b260 100644
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialog.dcu and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialog.dcu differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogDE.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogDE.dcu
index 9552f8b..93222b5 100644
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogDE.dcu and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogDE.dcu differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogEx.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogEx.dcu
deleted file mode 100644
index e9f7a71..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogEx.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.bpl b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.bpl
new file mode 100644
index 0000000..66bc969
Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.bpl differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcp b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcp
new file mode 100644
index 0000000..19397ab
Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcp differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcu
new file mode 100644
index 0000000..633e74c
Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcu differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.bpl b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.bpl
deleted file mode 100644
index c0d26af..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.bpl and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.dcp b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.dcp
deleted file mode 100644
index 2fb026e..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.dcp and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.dcu
deleted file mode 100644
index e1b1cdb..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009D.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.bpl b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.bpl
deleted file mode 100644
index f2260dc..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.bpl and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.dcp b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.dcp
deleted file mode 100644
index 167968f..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.dcp and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.dcu
deleted file mode 100644
index 9ad6b5f..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkgD2009R.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogRegDE.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogRegDE.dcu
index c537d25..85baa21 100644
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogRegDE.dcu and b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogRegDE.dcu differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advgdip.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advgdip.dcu
deleted file mode 100644
index 779ff6f..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advgdip.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advglowbutton.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advglowbutton.dcu
deleted file mode 100644
index 6f9e70a..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advglowbutton.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advhintinfo.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advhintinfo.dcu
deleted file mode 100644
index c30f4c2..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advhintinfo.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advstyleif.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advstyleif.dcu
deleted file mode 100644
index 9ce4e3e..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/advstyleif.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/gdipicture.dcu b/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/gdipicture.dcu
deleted file mode 100644
index e30410c..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/gdipicture.dcu and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvGroupBox.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvGroupBox.pas
deleted file mode 100644
index 4860dc5..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvGroupBox.pas
+++ /dev/null
@@ -1,668 +0,0 @@
-{***************************************************************************}
-{ TAdvGroupBox component }
-{ 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 AdvGroupBox;
-
-{$I TMSDEFS.INC}
-
-interface
-
-uses
- Classes, Windows, Forms, Dialogs, Controls, Graphics, Messages, ExtCtrls,
- SysUtils, Math, StdCtrls, ImgList;
-
-const
-
- MAJ_VER = 1; // Major version nr.
- MIN_VER = 0; // Minor version nr.
- REL_VER = 0; // Release nr.
- BLD_VER = 1; // Build nr.
-
- // version history
- // v1.0.0.0 : first release
- // v1.0.0.1 : fixed issue for XP theming
-
-
-type
- TCaptionPosition = (cpTopLeft, cpTopRight, cpTopCenter, cpBottomLeft, cpBottomRight, cpBottomCenter);
- TBorderStyle = (bsNone, bsSingle, bsDouble);
-
- TWinCtrl = class(TWinControl)
- public
- procedure PaintCtrls(DC: HDC; First: TControl);
- end;
-
- TAdvCustomGroupBox = class(TCustomGroupBox)
- private
- FTransparent: Boolean;
- FBorderColor: TColor;
- FImageIndex: Integer;
- FImages: TCustomImageList;
- FBorderStyle: TBorderStyle;
- FCaptionPosition: TCaptionPosition;
- FRoundEdges: Boolean;
- Procedure WMEraseBkGnd( Var msg: TWMEraseBkGnd ); message WM_ERASEBKGND;
- procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
- procedure SetTransparent(const Value: Boolean);
- procedure SetBorderColor(const Value: TColor);
- procedure SetImageIndex(const Value: Integer);
- procedure SetImages(const Value: TCustomImageList);
- function GetVersion: string;
- procedure SetVersion(const Value: string);
- procedure SetBorderStyle(const Value: TBorderStyle);
- procedure SetCaptionPosition(const Value: TCaptionPosition);
- procedure SetRoundEdges(const Value: Boolean);
- protected
- procedure Loaded; override;
- procedure Paint; override;
- procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
- procedure AdjustClientRect(var Rect: TRect); override;
- procedure CreateParams(var Params: TCreateParams); override;
- function GetCaptionHeight: Integer;
- function GetCaptionRect: TRect;
- function GetBorderWidth: Integer;
- function GetBorderRect: TRect;
-
- property CaptionPosition: TCaptionPosition read FCaptionPosition write SetCaptionPosition default cpTopLeft;
- property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
- property Transparent: Boolean read FTransparent write SetTransparent default true;
- property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver;
- property Images: TCustomImageList read FImages write SetImages;
- property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
- property Version: string read GetVersion write SetVersion stored false;
- property RoundEdges: Boolean read FRoundEdges write SetRoundEdges default False;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function GetVersionNr: integer;
- end;
-
- TAdvGroupBox = class(TAdvCustomGroupBox)
- published
- property BorderColor;
- property BorderStyle;
- property CaptionPosition;
- property Images;
- property ImageIndex;
- property Transparent;
- property RoundEdges;
- property Version;
-
- property Align;
- property Anchors;
- property BiDiMode;
- property Caption;
- property Color;
- property Constraints;
- property Ctl3D default False;
- property DockSite;
- property DragCursor;
- property DragKind;
- property DragMode;
- property Enabled;
- property Font;
- {$IFDEF DELPHI7_LVL}
- property ParentBackground default True;
- {$ENDIF}
- property ParentBiDiMode;
- property ParentColor;
- property ParentCtl3D default False;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDockDrop;
- property OnDockOver;
- property OnDragOver;
- property OnEndDock;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetSiteInfo;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDock;
- property OnStartDrag;
- property OnUnDock;
- end;
-
-implementation
-
-//------------------------------------------------------------------------------
-
-{TWinCtrl}
-
-procedure TWinCtrl.PaintCtrls(DC: HDC; First: TControl);
-begin
- PaintControls(DC, First);
-end;
-
-//------------------------------------------------------------------------------
-
-{ TAdvCustomGroupBox }
-
-constructor TAdvCustomGroupBox.Create(AOwner: TComponent);
-begin
- inherited;
- ControlStyle := ControlStyle - [csOpaque];
- FTransparent := True;
- FImages := nil;
- FImageIndex := -1;
- FBorderStyle := bsSingle;
- FCaptionPosition := cpTopLeft;
- FRoundEdges := false;
-// Ctl3D := false;
-// ParentCtl3D := false;
- FBorderColor := clSilver;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.CreateParams(var Params: TCreateParams);
-begin
- inherited CreateParams( params );
- //params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
-end;
-
-//------------------------------------------------------------------------------
-
-destructor TAdvCustomGroupBox.Destroy;
-begin
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.Loaded;
-begin
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.Notification(AComponent: TComponent;
- AOperation: TOperation);
-begin
- inherited;
- if not (csDestroying in ComponentState) and (AOperation = opRemove) then
- begin
- if (AComponent = Images) then
- begin
- Images := nil;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.AdjustClientRect(var Rect: TRect);
-var
- R: TRect;
-begin
- R := Rect;
- inherited AdjustClientRect(Rect);
- Rect := R;
- if CaptionPosition in [cpTopLeft, cpTopCenter, cpTopRight] then
- begin
- Inc(Rect.Top, Max(GetBorderWidth,GetCaptionHeight));
- Rect := Classes.Rect(Rect.Left + GetBorderWidth, Rect.Top, Rect.Right -GetBorderWidth, Rect.Bottom-GetBorderWidth);
- end
- else if CaptionPosition in [cpBottomLeft, cpBottomCenter, cpBottomRight] then
- begin
- Dec(Rect.Bottom, Max(GetBorderWidth,GetCaptionHeight));
- Rect := Classes.Rect(Rect.Left + GetBorderWidth, Rect.Top + GetBorderWidth, Rect.Right -GetBorderWidth, Rect.Bottom);
- end;
-
- InflateRect(Rect, -1, -1);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.Paint;
-var
- R, CapR: TRect;
- i, rt: Integer;
- P: TPoint;
- bmp: TBitmap;
-begin
- if Transparent then
- begin
- i := SaveDC(Canvas.Handle);
- p := ClientOrigin;
- Windows.ScreenToClient(Parent.Handle, p);
- p.x := -p.x;
- p.y := -p.y;
- MoveWindowOrg(Canvas.Handle, p.x, p.y);
-
- SendMessage(Parent.Handle, WM_ERASEBKGND, Canvas.Handle, 0);
- // transparency ?
- SendMessage(Parent.Handle, WM_PAINT, Canvas.Handle, 0);
-
- if (Parent is TWinCtrl) then
- begin
- (Parent as TWinCtrl).PaintCtrls(Canvas.Handle, nil);
- end;
-
- RestoreDC(Canvas.Handle, i);
- end;
-
- R := ClientRect;
- CapR := GetCaptionRect;
- bmp := TBitmap.Create;
- bmp.Height := (CapR.Bottom - CapR.Top);
- bmp.Width := (CapR.Right - CapR.Left) + 2;
- i := CapR.Left;
- rt := 6;
-
- //--- Draw Image
- if Assigned(Images) and (ImageIndex >= 0) then
- begin
- Images.Draw(Canvas, CapR.Left, CapR.Top, ImageIndex, Enabled);
- i := CapR.Left + Images.Width + 3;
- end;
-
- Canvas.Brush.Style := bsClear;
- //--- Draw Caption
- if (Caption <> '') then
- begin
- Canvas.Font.Assign(Self.Font);
- R := Rect(i, CapR.Top, CapR.Right, CapR.Bottom);
- DrawText(Canvas.Handle,PChar(Caption),Length(Caption), R, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
- end;
-
- bmp.Canvas.CopyRect(Rect(0, 0, bmp.Width, bmp.Height), Canvas, Rect(CapR.Left-1, CapR.Top, CapR.Right+1, CapR.Bottom));
- R := GetBorderRect;
- //--- Draw Borders
- case BorderStyle of
- bsSingle:
- begin
- (*
- if Ctl3D then
- begin
-
- Canvas.Brush.Style := bsClear;
- Canvas.Pen.Color := clWhite;
- R.Left := R.Left + 1;
- R.Top := R.Top + 1;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
-
- Canvas.Pen.Color := clGray;
- R.Bottom := R.Bottom -1;
- R.Right := R.Right - 1;
- R.Left := R.Left - 1;
- R.Top := R.Top - 1;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- end
- else
- *)
- begin
- Canvas.Brush.Style := bsClear;
- Canvas.Pen.Color := BorderColor;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- end;
- end;
- bsDouble:
- begin
- if Ctl3D then
- begin
- Canvas.Brush.Style := bsClear;
- Canvas.Pen.Color := clWhite;
- R.Left := R.Left + 1;
- R.Top := R.Top + 1;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- Canvas.Pen.Color := clGray;
- R.Bottom := R.Bottom -1;
- R.Right := R.Right - 1;
- R.Left := R.Left - 1;
- R.Top := R.Top - 1;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
-
- R.Bottom := R.Bottom +1;
- R.Right := R.Right + 1;
-
- R := Rect(R.Left+2, R.Top+2, R.Right-2, R.Bottom-2);
-
- Canvas.Pen.Color := clWhite;
- R.Left := R.Left + 1;
- R.Top := R.Top + 1;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- Canvas.Pen.Color := clGray;
- R.Bottom := R.Bottom -1;
- R.Right := R.Right - 1;
- R.Left := R.Left - 1;
- R.Top := R.Top - 1;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- end
- else
- begin
- Canvas.Brush.Style := bsClear;
- Canvas.Pen.Color := BorderColor;
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- R := Rect(R.Left+2, R.Top+2, R.Right-2, R.Bottom-2);
- if FRoundEdges then
- Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
- else
- Canvas.Rectangle(R);
- end;
- end;
- end;
-
- if ((Caption <> '') or (Assigned(Images) and (ImageIndex >= 0))) then
- begin
- Canvas.CopyRect(Rect(CapR.Left-1, CapR.Top, CapR.Right+1, CapR.Bottom), bmp.Canvas, Rect(0, 0, bmp.Width, bmp.Height));
- end;
- bmp.Free;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetBorderColor(const Value: TColor);
-begin
- if (FBorderColor <> Value) then
- begin
- FBorderColor := Value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetImageIndex(const Value: Integer);
-begin
- if (FImageIndex <> Value) then
- begin
- FImageIndex := Value;
- Invalidate;
- Realign;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetImages(const Value: TCustomImageList);
-begin
- if (FImages <> Value) then
- begin
- FImages := Value;
- if not Assigned(FImages) then
- begin
- ImageIndex := -1;
- end;
- Invalidate;
- Realign;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetTransparent(const Value: Boolean);
-begin
- if (FTransparent <> Value) then
- begin
- FTransparent := Value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.WMEraseBkGnd(var msg: TWMEraseBkGnd);
-begin
- inherited;
- //SetBkMode( msg.DC, TRANSPARENT );
- //msg.result := 1;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGroupBox.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 TAdvCustomGroupBox.GetVersionNr: integer;
-begin
- Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetVersion(const Value: string);
-begin
-
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGroupBox.GetCaptionHeight: Integer;
-var
- R: TRect;
-begin
- R := GetCaptionRect;
- Result := Max(GetBorderWidth, R.Bottom - R.Top);
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGroupBox.GetBorderWidth: Integer;
-begin
- Result := 0;
- case BorderStyle of
- bsNone: Result := 1;
- bsSingle:
- begin
- Result := 1;
- if Ctl3D then
- Result := Result + 1;
- end;
- bsDouble:
- begin
- Result := 2;
- if Ctl3D then
- Result := Result + 2;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGroupBox.GetBorderRect: TRect;
-begin
- Result := ClientRect;
- if CaptionPosition in [cpTopLeft, cpTopCenter, cpTopRight] then
- begin
- Result.Top := Result.Top + (GetCaptionHeight div 2);
- end
- else if CaptionPosition in [cpBottomLeft, cpBottomCenter, cpBottomRight] then
- begin
- if ((Caption <> '') or (Assigned(Images) and (ImageIndex >= 0))) then
- begin
- Result.Bottom := Result.Bottom - (GetCaptionHeight div 2);
- if (BorderStyle = bsDouble) then
- Result.Bottom := Result.Bottom + 1;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGroupBox.GetCaptionRect: TRect;
-var
- ImgH, ImgW, CapH, CapW, sp, st, w, h: Integer;
- R: TRect;
-begin
- Result := Rect(0, 0, 0, 0);
- ImgH := 0;
- ImgW := 0;
- CapH := 0;
- CapW := 0;
- st := 8;
- sp := 0;
- if (Caption <> '') then
- begin
- Canvas.Font.Assign(Self.Font);
- R := Rect(0, 0, 1000, 100);
- DrawText(Canvas.Handle,PChar(Caption),Length(Caption), R, DT_CALCRECT or DT_LEFT or DT_SINGLELINE);
- CapH := R.Bottom - R.Top;
- CapW := R.Right - R.Left;
- end;
-
- if Assigned(Images) and (ImageIndex >= 0) then
- begin
- ImgH := Images.Height;
- ImgW := Images.Width;
- end;
-
- if (CapW > 0) and (ImgW > 0) then
- begin
- sp := 3;
- end;
-
- w := ImgW + sp + CapW;
- h := Max(ImgH, CapH) + 2;
- case CaptionPosition of
- cpTopLeft:
- begin
- Result.Left := st;
- Result.Right := Result.Left + w;
- Result.Bottom := Result.Top + h;
- end;
- cpTopRight:
- begin
- Result.Right := Width - st;
- Result.Left := Result.Right - w;
- Result.Bottom := Result.Top + h;
- end;
- cpTopCenter:
- begin
- Result.Left := (Width - w) div 2;
- Result.Right := Result.Left + w;
- Result.Bottom := Result.Top + h;
- end;
- cpBottomLeft:
- begin
- Result.Left := st;
- Result.Right := Result.Left + w;
- Result.Top := Height - h;
- Result.Bottom := Result.Top + h;
- end;
- cpBottomRight:
- begin
- Result.Right := Width - st;
- Result.Left := Result.Right - w;
- Result.Top := Height - h;
- Result.Bottom := Result.Top + h;
- end;
- cpBottomCenter:
- begin
- Result.Left := (Width - w) div 2;
- Result.Right := Result.Left + w;
- Result.Top := Height - h;
- Result.Bottom := Result.Top + h;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.CMCtl3DChanged(var Message: TMessage);
-begin
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetBorderStyle(const Value: TBorderStyle);
-begin
- if (FBorderStyle <> Value) then
- begin
- FBorderStyle := Value;
- Invalidate;
- Realign;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetCaptionPosition(
- const Value: TCaptionPosition);
-begin
- if (FCaptionPosition <> Value) then
- begin
- FCaptionPosition := Value;
- Invalidate;
- Realign;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGroupBox.SetRoundEdges(const Value: Boolean);
-begin
- if (FRoundEdges <> Value) then
- begin
- FRoundEdges := Value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-{$IFDEF FREEWARE}
-{$I TRIAL.INC}
-{$ENDIF}
-
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvOfficeButtons.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvOfficeButtons.pas
deleted file mode 100644
index f8f0570..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvOfficeButtons.pas
+++ /dev/null
@@ -1,2814 +0,0 @@
-{*************************************************************************}
-{ 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, 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 = 1; // Release nr.
- BLD_VER = 4; // 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
- // 1.1.0.9 : Fixed : issue with vertical alignment of radiobutton label text
- // 1.1.1.0 : Improved : BidiMode RightToLeft support
- // 1.1.1.1 : Fixed : painting issue with BiDiMode bdRightToLeft for radiobutton
- // 1.1.1.2 : Fixed : issue with transparency on Windows Vista
- // 1.1.1.3 : Improved : tab key handling for TAdvOfficeCheckGroup
- // 1.1.1.4 : Fixed : background painting issue with Delphi 2009
-
-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 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 SetChecked(Value:Boolean); virtual;
- function GetChecked:Boolean; virtual;
- 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 Loaded; override;
- procedure DoEnter; override;
- procedure DoExit; 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 Align;
- property Anchors;
- property Constraints;
- property Color;
- property Alignment: TLeftRight read FAlignment write SetAlignment;
- property BiDiMode;
- 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
- property Align;
- {$IFDEF DELPHI4_LVL}
- property Action;
- property Anchors;
- property BiDiMode;
- 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 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;
- FFocusButtonIdx: integer;
- procedure ArrangeButtons;
- procedure ButtonClick(Sender: TObject);
- procedure CheckFocus(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 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 DoEnter; override;
- procedure DoExit; override;
- procedure ReadState(Reader: TReader); override;
- function CanModify: Boolean; virtual;
- function GetChecked(Index: Integer): Boolean; virtual;
- procedure SetChecked(Index: Integer; const Value: 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 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;
-
-{$IFNDEF TMSDOTNET}
-function IsVista: boolean;
-var
- hKernel32: HMODULE;
-begin
- hKernel32 := GetModuleHandle('kernel32');
- if (hKernel32 > 0) then
- begin
- Result := GetProcAddress(hKernel32, 'GetLocaleInfoEx') <> nil;
- end
- else
- Result := false;
-end;
-{$ENDIF}
-
-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) or UseRightToLeftAlignment 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
- {$IFNDEF DELPHI_UNICODE}
- if FDrawBkg or IsVista then
- {$ENDIF}
- DrawParentImage(Self, Canvas);
- end;
-
- with Canvas do
- begin
- Text := Caption;
-
- DrawCheck;
-
- ExtraBW := 4;
-
- R := GetClientRect;
-
- if (FAlignment = taRightJustify) or UseRightToLeftAlignment then
- begin
- r.Left := 0;
- r.Right := r.Right - BW - ExtraBW;
- end
- else
- r.Left := r.Left + BW + ExtraBW;
-
- r.top := r.top + 4;
-
-
- HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,True,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 UseRightToLeftAlignment then
- r.Left := r.Right - Xsize - 3;
-
- 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
- {$IFDEF DELPHI_UNICODE}
- inherited;
- {$ENDIF}
- {$IFNDEF DELPHI_UNICODE}
- Message.Result := 1
- {$ENDIF}
-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) or UseRightToLeftAlignment 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
- {$IFNDEF DELPHI_UNICODE}
- if DrawBkg or IsVista then
- {$ENDIF}
- DrawParentImage(Self, self.Canvas);
- end;
-
- with Canvas do
- begin
- BR := 13;
- DrawRadio;
-
- r := GetClientRect;
- if (FAlignment = taRightJustify) or UseRightToLeftAlignment then
- begin
- r.Left := 0;
- r.Right := r.Right - BR - 5;
- end
- else
- r.Left := r.Left + BR + 5;
-
- r.Top := r.Top + 4;
-
- HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,True,False,False,False,False,False,not FEllipsis,1.0,clGray,
- clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0);
-
- if UseRightToLeftAlignment then
- r.Left := r.Right - Xsize - 3;
-
- if ButtonVertAlign in [tlCenter, tlBottom] then
- begin
- HTMLDrawEx(Canvas,Text,R,FImages,0,0,-1,-1,FShadowOffset,false,true,False,False,False,False,not FEllipsis,1.0,FURLColor,
- clNone,clNone,FShadowColor,a,s,fa,XSize,YSize,HyperLinks,MouseLink,hr,FImageCache,FContainer,0);
- case ButtonVertAlign of
- tlCenter: r.Top := r.Top - 3 + (r.Bottom - r.Top - YSize) div 2;
- tlBottom: r.Top := r.Bottom - YSize - 3;
- end;
- end;
-
- 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;
- if BiDiMode = bdLeftToRight then
- begin
- R.Right := 16;
- end
- else
- begin
- R.Left := R.Right - 16;
- end;
-
- 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
- {$IFDEF DELPHI_UNICODE}
- inherited;
- {$ENDIF}
- {$IFNDEF DELPHI_UNICODE}
- Message.Result := 1
- {$ENDIF}
-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;
-
- if Length(Caption) <= 0 then
- TopMargin := TopMargin - Metrics.tmHeight 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;
- OnEnter := CheckGroup.CheckFocus;
- 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;
-
- if Length(Caption) <= 0 then
- TopMargin := TopMargin - Metrics.tmHeight 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.CheckFocus(Sender: TObject);
-var
- i: integer;
-begin
- for i := 0 to FButtons.Count - 1 do
- begin
- if TGroupCheck(FButtons[i]).Focused then
- FFocusButtonIdx := i;
- 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.DoExit;
-begin
- inherited;
-end;
-
-procedure TCustomAdvOfficeCheckGroup.DoEnter;
-begin
- inherited;
-
- if FButtons.Count > FFocusButtonIdx then
- begin
- if TGroupCheck(FButtons[FFocusButtonIdx]).HandleAllocated then
- begin
- TGroupCheck(FButtons[FFocusButtonIdx]).SetFocus;
- Invalidate;
- end;
- 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.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvOfficeButtons.res b/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvOfficeButtons.res
deleted file mode 100644
index 8f0cdb9..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Source/AdvOfficeButtons.res and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/D2009.groupproj b/TAdvTaskDialog/internal/1.5.1.2/1/Source/D2009.groupproj
deleted file mode 100644
index 6ffe9f7..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/D2009.groupproj
+++ /dev/null
@@ -1,48 +0,0 @@
-
-
- {79C894D4-A16D-4924-81DC-BB8F72238C44}
-
-
-
-
-
-
-
-
-
-
- Default.Personality.12
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/SpanishContst.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/SpanishContst.pas
new file mode 100644
index 0000000..09c45f7
--- /dev/null
+++ b/TAdvTaskDialog/internal/1.5.1.2/1/Source/SpanishContst.pas
@@ -0,0 +1,21 @@
+unit SpanishContst;
+
+interface
+
+resourcestring
+ SSpanishMsgDlgOK = 'OK';
+ SSpanishMsgDlgYes = '&Si';
+ SSpanishMsgDlgNo = '&No';
+ SSpanishMsgDlgCancel = 'Cancelar';
+ SSpanishMsgDlgAbort = '&Abortar';
+ SSpanishMsgDlgRetry = '&Reintentar';
+
+ SSpanishMsgDlgWarning = 'Aviso';
+ SSpanishMsgDlgError = 'Error';
+ SSpanishMsgDlgInformation = 'Información';
+ SSpanishMsgDlgConfirm = 'Confirmación';
+
+
+implementation
+
+end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialog.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialog.pas
index e290e09..e821ac2 100644
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialog.pas
+++ b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialog.pas
@@ -549,6 +549,9 @@ procedure Register;
implementation
+uses
+ SpanishContst;
+
{$I HTMLENGO.PAS}
const
@@ -4772,18 +4775,18 @@ end;
initialization
//cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose);
- ButtonCaptions[cbOK] := @SMsgDlgOK;
- ButtonCaptions[cbYes] := @SMsgDlgYes;
- ButtonCaptions[cbNo] := @SMsgDlgNo;
- ButtonCaptions[cbCancel] := @SMsgDlgCancel;
- ButtonCaptions[cbRetry] := @SMsgDlgRetry;
- ButtonCaptions[cbClose] := @SMsgDlgAbort;
+ ButtonCaptions[cbOK] := @SSpanishMsgDlgOK;
+ ButtonCaptions[cbYes] := @SSpanishMsgDlgYes;
+ ButtonCaptions[cbNo] := @SSpanishMsgDlgNo;
+ ButtonCaptions[cbCancel] := @SSpanishMsgDlgCancel;
+ ButtonCaptions[cbRetry] := @SSpanishMsgDlgRetry;
+ ButtonCaptions[cbClose] := @SSpanishMsgDlgAbort;
Captions[tiBlank] := nil;
- Captions[tiWarning] := @SMsgDlgWarning;
- Captions[tiQuestion] := @SMsgDlgConfirm;
- Captions[tiError] := @SMsgDlgError;
- Captions[tiShield] := @SMsgDlgInformation;
+ Captions[tiWarning] := @SSpanishMsgDlgWarning;
+ Captions[tiQuestion] := @SSpanishMsgDlgConfirm;
+ Captions[tiError] := @SSpanishMsgDlgError;
+ Captions[tiShield] := @SSpanishMsgDlgInformation;
{$IFDEF FREEWARE}
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogEx.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogEx.pas
deleted file mode 100644
index c1a40fe..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogEx.pas
+++ /dev/null
@@ -1,300 +0,0 @@
-{***************************************************************************}
-{ TTaskDialogEx component }
-{ 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 TaskDialogEx;
-
-{$I TMSDEFS.INC}
-
-interface
-
-uses
- Classes, Windows, Messages, Forms, Dialogs, SysUtils, StdCtrls, Graphics, Consts, Math,
- ExtCtrls, Controls, TaskDialog, AdvGlowButton, AdvOfficeButtons;
-
-type
- TButtonCreatedEvent = procedure(Sender: TObject; Button: TAdvGlowButton) of object;
-
- TAdvTaskDialogEx = class(TAdvTaskDialog)
- private
- FOnButtonCreated: TButtonCreatedEvent;
- FAppearance: TGlowButtonAppearance;
- protected
- function CreateRadioButton(AOwner: TComponent): TWinControl; override;
- procedure SetRadioButtonState(Btn: TWinControl; Checked: boolean); override;
- procedure SetRadioButtonCaption(Btn: TWinControl; Value: string); override;
- function CreateButton(AOwner: TComponent): TWinControl; override;
- procedure InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); override;
- procedure SetButtonCaption(aButton: TWinControl; Value: TCaption); override;
- procedure SetButtonCancel(aButton: TWinControl; Value: Boolean); override;
- procedure SetButtonDefault(aButton: TWinControl; Value: Boolean); override;
- procedure SetButtonModalResult(aButton: TWinControl; Value: Integer); override;
- function GetButtonModalResult(aButton: TWinControl): Integer; override;
- public
- property Appearance: TGlowButtonAppearance read FAppearance write FAppearance;
- property OnButtonCreated:TButtonCreatedEvent read FOnButtonCreated write FOnButtonCreated;
- end;
-
- TAdvInputTaskDialogEx = class(TAdvInputTaskDialog)
- private
- FOnButtonCreated: TButtonCreatedEvent;
- FAppearance: TGlowButtonAppearance;
- protected
- function CreateRadioButton(AOwner: TComponent): TWinControl; override;
- procedure SetRadioButtonState(Btn: TWinControl; Checked: boolean); override;
- procedure SetRadioButtonCaption(Btn: TWinControl; Value: string); override;
- function CreateButton(AOwner: TComponent): TWinControl; override;
- procedure InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); override;
- procedure SetButtonCaption(aButton: TWinControl; Value: TCaption); override;
- procedure SetButtonCancel(aButton: TWinControl; Value: Boolean); override;
- procedure SetButtonDefault(aButton: TWinControl; Value: Boolean); override;
- procedure SetButtonModalResult(aButton: TWinControl; Value: Integer); override;
- function GetButtonModalResult(aButton: TWinControl): Integer; override;
- public
- property Appearance: TGlowButtonAppearance read FAppearance write FAppearance;
- property OnButtonCreated:TButtonCreatedEvent read FOnButtonCreated write FOnButtonCreated;
- end;
-
-
-procedure Register;
-
-implementation
-
-//------------------------------------------------------------------------------
-
-procedure Register;
-begin
- RegisterComponents('TMS',[TAdvTaskDialogEx]);
-end;
-
-//------------------------------------------------------------------------------
-
-{ TAdvTaskDialogEx }
-
-function TAdvTaskDialogEx.CreateButton(AOwner: TComponent): TWinControl;
-begin
- Result := TAdvGlowButton.Create(AOwner);
- if Assigned(FAppearance) then
- (Result as TAdvGlowButton).Appearance := FAppearance;
- (Result as TAdvGlowButton).TabStop := true;
- if Assigned(FOnButtonCreated) then
- FOnButtonCreated(Self,(Result as TAdvGlowButton));
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvTaskDialogEx.CreateRadioButton(AOwner: TComponent): TWinControl;
-begin
- Result := TAdvOfficeRadioButton.Create(AOwner);
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvTaskDialogEx.GetButtonModalResult(
- aButton: TWinControl): Integer;
-begin
- Result := mrNone;
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- Result := TAdvGlowButton(aButton).ModalResult;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.SetButtonCancel(aButton: TWinControl;
- Value: Boolean);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).Cancel := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.SetButtonCaption(aButton: TWinControl;
- Value: TCaption);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).Caption := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.SetButtonDefault(aButton: TWinControl;
- Value: Boolean);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).Default := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.SetButtonModalResult(aButton: TWinControl;
- Value: Integer);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).ModalResult := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.SetRadioButtonCaption(Btn: TWinControl;
- Value: string);
-begin
- TAdvOfficeRadioButton(Btn).Caption := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.SetRadioButtonState(Btn: TWinControl;
- Checked: boolean);
-begin
- TAdvOfficeRadioButton(Btn).Checked := Checked;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvTaskDialogEx.InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent);
-begin
- with TRadioButton(Btn) do
- begin
- Name := 'Radio' + inttostr(btnIndex);
- Parent := AOwner;
- Font.Name := AOwner.Canvas.Font.Name;
- Font.Size := 8;
- BiDiMode := AOwner.BiDiMode;
- OnClick := OnClickEvent;
-
- {
- BoundsRect := TextRect;
- Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin;
- Top := Y;
- Width := Self.Width - Left - 4;
- GetTextSize(Canvas, Caption, k, l);
- w := Max(w, Left + k + FHorzMargin + 20);
- }
- end;
-end;
-
-{ TAdvInputTaskDialogEx }
-
-//------------------------------------------------------------------------------
-
-function TAdvInputTaskDialogEx.CreateButton(AOwner: TComponent): TWinControl;
-begin
- Result := TAdvGlowButton.Create(AOwner);
- if Assigned(FAppearance) then
- (Result as TAdvGlowButton).Appearance := FAppearance;
- (Result as TAdvGlowButton).TabStop := true;
- if Assigned(FOnButtonCreated) then
- FOnButtonCreated(Self,(Result as TAdvGlowButton));
-end;
-
-function TAdvInputTaskDialogEx.CreateRadioButton(
- AOwner: TComponent): TWinControl;
-begin
- Result := TAdvOfficeRadioButton.Create(AOwner);
-end;
-
-function TAdvInputTaskDialogEx.GetButtonModalResult(
- aButton: TWinControl): Integer;
-begin
- Result := mrNone;
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- Result := TAdvGlowButton(aButton).ModalResult;
-end;
-
-procedure TAdvInputTaskDialogEx.SetButtonCancel(aButton: TWinControl;
- Value: Boolean);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).Cancel := Value;
-end;
-
-procedure TAdvInputTaskDialogEx.SetButtonCaption(aButton: TWinControl;
- Value: TCaption);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).Caption := Value;
-end;
-
-procedure TAdvInputTaskDialogEx.SetButtonDefault(aButton: TWinControl;
- Value: Boolean);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).Default := Value;
-end;
-
-procedure TAdvInputTaskDialogEx.SetButtonModalResult(aButton: TWinControl;
- Value: Integer);
-begin
- if not Assigned(aButton) or not (aButton is TAdvGlowButton) then
- Exit;
-
- TAdvGlowButton(aButton).ModalResult := Value;
-end;
-
-procedure TAdvInputTaskDialogEx.SetRadioButtonCaption(Btn: TWinControl;
- Value: string);
-begin
- TAdvOfficeRadioButton(Btn).Caption := Value;
-end;
-
-procedure TAdvInputTaskDialogEx.SetRadioButtonState(Btn: TWinControl;
- Checked: boolean);
-begin
- TAdvOfficeRadioButton(Btn).Checked := Checked;
-end;
-
-procedure TAdvInputTaskDialogEx.InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent);
-begin
- with TRadioButton(Btn) do
- begin
- Name := 'Radio' + inttostr(btnIndex);
- Parent := AOwner;
- Font.Name := AOwner.Canvas.Font.Name;
- Font.Size := 8;
- BiDiMode := AOwner.BiDiMode;
- OnClick := OnClickEvent;
- {
- BoundsRect := TextRect;
- Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin;
- Top := Y;
- Width := Self.Width - Left - 4;
- GetTextSize(Canvas, Caption, k, l);
- w := Max(w, Left + k + FHorzMargin + 20);
- }
- end;
-end;
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.dpk b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.dpk
similarity index 69%
rename from TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.dpk
rename to TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.dpk
index 9fd4a70..3a513ea 100644
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.dpk
+++ b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.dpk
@@ -1,4 +1,4 @@
-package TaskDialogPkgD2009D;
+package TaskDialogPkg;
{$R *.res}
{$ALIGN 8}
@@ -28,12 +28,13 @@ package TaskDialogPkgD2009D;
requires
rtl,
vcl,
- designide,
- dbrtl,
- vcldb;
+ designide;
contains
TaskDialogRegDE in 'TaskDialogRegDE.pas',
- TaskDialogEx in 'TaskDialogEx.pas';
+ SpanishContst in 'SpanishContst.pas',
+ TaskDialog in 'TaskDialog.pas',
+ TaskDialogDE in 'TaskDialogDE.pas',
+ picturecontainer in 'picturecontainer.pas';
end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.dproj b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.dproj
similarity index 86%
rename from TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.dproj
rename to TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.dproj
index f43e15e..da453d2 100644
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.dproj
+++ b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.dproj
@@ -1,7 +1,7 @@

{322e4f51-9fd5-43be-8659-42e8edcc60b1}
- TaskDialogPkgD2009D.dpk
+ TaskDialogPkg.dpk
Release
AnyCPU
DCC32
@@ -13,8 +13,7 @@
true
- ..\Lib\D12;$(DCC_UnitSearchPath)
- ..\Lib\D12\TaskDialogPkgD2009D.bpl
+ ..\Lib\D12\TaskDialogPkg.bpl
00400000
false
..\Lib\D12
@@ -66,23 +65,24 @@
- TaskDialogPkgD2009D.dpk
+ TaskDialogPkg.dpk
12
-
+
MainSource
-
-
-
+
+
+
+
Base
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.res b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.res
similarity index 100%
rename from TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009D.res
rename to TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkg.res
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.dpk b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.dpk
deleted file mode 100644
index 73cc579..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.dpk
+++ /dev/null
@@ -1,47 +0,0 @@
-package TaskDialogPkgD2009R;
-
-{$R *.res}
-{$ALIGN 8}
-{$ASSERTIONS ON}
-{$BOOLEVAL OFF}
-{$DEBUGINFO OFF}
-{$EXTENDEDSYNTAX ON}
-{$IMPORTEDDATA ON}
-{$IOCHECKS ON}
-{$LOCALSYMBOLS OFF}
-{$LONGSTRINGS ON}
-{$OPENSTRINGS ON}
-{$OPTIMIZATION ON}
-{$OVERFLOWCHECKS OFF}
-{$RANGECHECKS OFF}
-{$REFERENCEINFO OFF}
-{$SAFEDIVIDE OFF}
-{$STACKFRAMES OFF}
-{$TYPEDADDRESS OFF}
-{$VARSTRINGCHECKS ON}
-{$WRITEABLECONST OFF}
-{$MINENUMSIZE 1}
-{$IMAGEBASE $400000}
-{$DESCRIPTION 'TMS TaskDialog'}
-{$IMPLICITBUILD OFF}
-
-requires
- rtl,
- vcl,
- designide,
- dbrtl,
- vcldb;
-
-contains
- TaskDialog in 'TaskDialog.pas',
- PictureContainer in 'PictureContainer.pas',
- TaskDialogDE in 'TaskDialogDE.pas',
- advgdip in 'advgdip.pas',
- advglowbutton in 'advglowbutton.pas',
- AdvGroupBox in 'AdvGroupBox.pas',
- advhintinfo in 'advhintinfo.pas',
- AdvOfficeButtons in 'AdvOfficeButtons.pas',
- advstyleif in 'advstyleif.pas',
- gdipicture in 'gdipicture.pas';
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.dproj b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.dproj
deleted file mode 100644
index 063ba03..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.dproj
+++ /dev/null
@@ -1,98 +0,0 @@
-
-
- {322e4f51-9fd5-43be-8659-42e8edcc60b1}
- TaskDialogPkgD2009R.dpk
- Release
- AnyCPU
- DCC32
- ..\Lib\D11\TaskDialogPkgD2007.bpl
- 12.0
- Base
-
-
- true
-
-
- ..\Lib\D12\TaskDialogPkgD2009R.bpl
- 00400000
- false
- ..\Lib\D12
- false
- TMS TaskDialog
- false
- true
- ..\Lib\D12
- true
- 0
- true
- ..\Lib\D12
-
-
- Delphi.Personality.12
- Package
-
-
-
- False
- True
- False
-
-
- True
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 2067
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
- TaskDialogPkgD2009R.dpk
-
-
-
- 12
-
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- Base
-
-
-
-
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.res b/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.res
deleted file mode 100644
index 5fc5c89..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Source/TaskDialogPkgD2009R.res and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advgdip.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/advgdip.pas
deleted file mode 100644
index 31872be..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advgdip.pas
+++ /dev/null
@@ -1,3335 +0,0 @@
-{***************************************************************************}
-{ GDI+ API Imports }
-{ for Delphi & C++Builder }
-{ }
-{ written by TMS Software }
-{ copyright © 2006 - 2009 }
-{ 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 AdvGDIP;
-
-{$HPPEMIT ''}
-{$HPPEMIT '#pragma link "gdiplus.lib"'}
-{$HPPEMIT ''}
-
-{$I TMSDEFS.INC}
-{$ALIGN ON}
-{$MINENUMSIZE 4}
-
-interface
-
-uses
- Windows, ActiveX, Math, Graphics;
-
-type
- INT16 = type Smallint;
- {$EXTERNALSYM INT16}
- UINT16 = type Word;
- {$EXTERNALSYM UINT16}
- PUINT16 = ^UINT16;
- {$EXTERNALSYM PUINT16}
- UINT32 = type Cardinal;
- {$EXTERNALSYM UINT32}
- TSingleDynArray = array of Single;
-
-var
- GlowSpeed : integer = 30;
-
-
-const
- GDIP_NOWRAP = 4096;
- {$EXTERNALSYM GDIP_NOWRAP}
- WINGDIPDLL = 'gdiplus.dll';
-
-//----------------------------------------------------------------------------
-// Memory Allocation APIs
-//----------------------------------------------------------------------------
-
-{$EXTERNALSYM GdipAlloc}
-function GdipAlloc(size: ULONG): pointer; stdcall;
-{$EXTERNALSYM GdipFree}
-procedure GdipFree(ptr: pointer); stdcall;
-
-(**************************************************************************\
-*
-* GDI+ base memory allocation class
-*
-\**************************************************************************)
-
-type
- TAntiAlias = (aaNone, aaClearType, aaAntiAlias);
-
- TGdiplusBase = class
- public
- class function NewInstance: TObject; override;
- procedure FreeInstance; override;
- end;
-
-//--------------------------------------------------------------------------
-// Fill mode constants
-//--------------------------------------------------------------------------
-
- FillMode = (
- FillModeAlternate, // 0
- FillModeWinding // 1
- );
- TFillMode = FillMode;
-
-//--------------------------------------------------------------------------
-// Quality mode constants
-//--------------------------------------------------------------------------
-
-{$IFDEF DELPHI6_UP}
- {$EXTERNALSYM QualityMode}
- QualityMode = (
- QualityModeInvalid = -1,
- QualityModeDefault = 0,
- QualityModeLow = 1, // Best performance
- QualityModeHigh = 2 // Best rendering quality
- );
- TQualityMode = QualityMode;
-{$ELSE}
- {$EXTERNALSYM QualityMode}
- QualityMode = Integer;
- const
- QualityModeInvalid = -1;
- QualityModeDefault = 0;
- QualityModeLow = 1; // Best performance
- QualityModeHigh = 2; // Best rendering quality
-{$ENDIF}
-
-type
-{$IFDEF DELPHI6_UP}
- {$EXTERNALSYM CompositingQuality}
- CompositingQuality = (
- CompositingQualityInvalid = ord(QualityModeInvalid),
- CompositingQualityDefault = ord(QualityModeDefault),
- CompositingQualityHighSpeed = ord(QualityModeLow),
- CompositingQualityHighQuality = ord(QualityModeHigh),
- CompositingQualityGammaCorrected,
- CompositingQualityAssumeLinear
- );
- TCompositingQuality = CompositingQuality;
-{$ELSE}
- {$EXTERNALSYM CompositingQuality}
- CompositingQuality = Integer;
- const
- CompositingQualityInvalid = QualityModeInvalid;
- CompositingQualityDefault = QualityModeDefault;
- CompositingQualityHighSpeed = QualityModeLow;
- CompositingQualityHighQuality = QualityModeHigh;
- CompositingQualityGammaCorrected = 3;
- CompositingQualityAssumeLinear = 4;
-
-type
- TCompositingQuality = CompositingQuality;
-{$ENDIF}
-
-const
- ImageFormatUndefined : TGUID = '{b96b3ca9-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatUndefined}
- ImageFormatMemoryBMP : TGUID = '{b96b3caa-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatMemoryBMP}
- ImageFormatBMP : TGUID = '{b96b3cab-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatBMP}
- ImageFormatEMF : TGUID = '{b96b3cac-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatEMF}
- ImageFormatWMF : TGUID = '{b96b3cad-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatWMF}
- ImageFormatJPEG : TGUID = '{b96b3cae-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatJPEG}
- ImageFormatPNG : TGUID = '{b96b3caf-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatPNG}
- ImageFormatGIF : TGUID = '{b96b3cb0-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatGIF}
- ImageFormatTIFF : TGUID = '{b96b3cb1-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatTIFF}
- ImageFormatEXIF : TGUID = '{b96b3cb2-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatEXIF}
- ImageFormatIcon : TGUID = '{b96b3cb5-0728-11d3-9d7b-0000f81ef32e}';
- {$EXTERNALSYM ImageFormatIcon}
-
-
-type
-//--------------------------------------------------------------------------
-// Unit constants
-//--------------------------------------------------------------------------
-
- Unit_ = (
- UnitWorld, // 0 -- World coordinate (non-physical unit)
- UnitDisplay, // 1 -- Variable -- for PageTransform only
- UnitPixel, // 2 -- Each unit is one device pixel.
- UnitPoint, // 3 -- Each unit is a printer's point, or 1/72 inch.
- UnitInch, // 4 -- Each unit is 1 inch.
- UnitDocument, // 5 -- Each unit is 1/300 inch.
- UnitMillimeter // 6 -- Each unit is 1 millimeter.
- );
- TUnit = Unit_;
-
-//--------------------------------------------------------------------------
-// Dash style constants
-//--------------------------------------------------------------------------
-
- DashStyle = (
- DashStyleSolid, // 0
- DashStyleDash, // 1
- DashStyleDot, // 2
- DashStyleDashDot, // 3
- DashStyleDashDotDot, // 4
- DashStyleCustom // 5
- );
- TDashStyle = DashStyle;
-
-
-//--------------------------------------------------------------------------
-// Various wrap modes for brushes
-//--------------------------------------------------------------------------
-
- WrapMode = (
- WrapModeTile, // 0
- WrapModeTileFlipX, // 1
- WrapModeTileFlipY, // 2
- WrapModeTileFlipXY, // 3
- WrapModeClamp // 4
- );
- TWrapMode = WrapMode;
-
-//--------------------------------------------------------------------------
-// LineGradient Mode
-//--------------------------------------------------------------------------
-
- LinearGradientMode = (
- LinearGradientModeHorizontal, // 0
- LinearGradientModeVertical, // 1
- LinearGradientModeForwardDiagonal, // 2
- LinearGradientModeBackwardDiagonal // 3
- );
- TLinearGradientMode = LinearGradientMode;
-
-//--------------------------------------------------------------------------
-// Line cap constants (only the lowest 8 bits are used).
-//--------------------------------------------------------------------------
-{$IFDEF DELPHI6_UP}
- {$EXTERNALSYM LineCap}
- LineCap = (
- LineCapFlat = 0,
- LineCapSquare = 1,
- LineCapRound = 2,
- LineCapTriangle = 3,
-
- LineCapNoAnchor = $10, // corresponds to flat cap
- LineCapSquareAnchor = $11, // corresponds to square cap
- LineCapRoundAnchor = $12, // corresponds to round cap
- LineCapDiamondAnchor = $13, // corresponds to triangle cap
- LineCapArrowAnchor = $14, // no correspondence
-
- LineCapCustom = $ff, // custom cap
-
- LineCapAnchorMask = $f0 // mask to check for anchor or not.
- );
- TLineCap = LineCap;
-{$ELSE}
- {$EXTERNALSYM LineCap}
- LineCap = Integer;
- const
- LineCapFlat = 0;
- LineCapSquare = 1;
- LineCapRound = 2;
- LineCapTriangle = 3;
-
- LineCapNoAnchor = $10; // corresponds to flat cap
- LineCapSquareAnchor = $11; // corresponds to square cap
- LineCapRoundAnchor = $12; // corresponds to round cap
- LineCapDiamondAnchor = $13; // corresponds to triangle cap
- LineCapArrowAnchor = $14; // no correspondence
-
- LineCapCustom = $ff; // custom cap
-
- LineCapAnchorMask = $f0; // mask to check for anchor or not.
-
-type
- TLineCap = LineCap;
-{$ENDIF}
-
-//--------------------------------------------------------------------------
-// Region Comine Modes
-//--------------------------------------------------------------------------
-
- CombineMode = (
- CombineModeReplace, // 0
- CombineModeIntersect, // 1
- CombineModeUnion, // 2
- CombineModeXor, // 3
- CombineModeExclude, // 4
- CombineModeComplement // 5 (Exclude From)
- );
- TCombineMode = CombineMode;
-
-//--------------------------------------------------------------------------
-// FontStyle: face types and common styles
-//--------------------------------------------------------------------------
-type
- {$EXTERNALSYM FontStyle}
- FontStyle = Integer;
- const
- FontStyleRegular = Integer(0);
- FontStyleBold = Integer(1);
- FontStyleItalic = Integer(2);
- FontStyleBoldItalic = Integer(3);
- FontStyleUnderline = Integer(4);
- FontStyleStrikeout = Integer(8);
- Type
- TFontStyle = FontStyle;
-
-//---------------------------------------------------------------------------
-// Smoothing Mode
-//---------------------------------------------------------------------------
-{$IFDEF DELPHI6_UP}
- {$EXTERNALSYM SmoothingMode}
- SmoothingMode = (
- SmoothingModeInvalid = ord(QualityModeInvalid),
- SmoothingModeDefault = ord(QualityModeDefault),
- SmoothingModeHighSpeed = ord(QualityModeLow),
- SmoothingModeHighQuality = ord(QualityModeHigh),
- SmoothingModeNone,
- SmoothingModeAntiAlias
- );
- TSmoothingMode = SmoothingMode;
-{$ELSE}
- SmoothingMode = Integer;
- const
- SmoothingModeInvalid = QualityModeInvalid;
- SmoothingModeDefault = QualityModeDefault;
- SmoothingModeHighSpeed = QualityModeLow;
- SmoothingModeHighQuality = QualityModeHigh;
- SmoothingModeNone = 3;
- SmoothingModeAntiAlias = 4;
-
-type
- TSmoothingMode = SmoothingMode;
-
-{$ENDIF}
-
-//---------------------------------------------------------------------------
-// Text Rendering Hint
-//---------------------------------------------------------------------------
-
- TextRenderingHint = (
- TextRenderingHintSystemDefault, // Glyph with system default rendering hint
- TextRenderingHintSingleBitPerPixelGridFit, // Glyph bitmap with hinting
- TextRenderingHintSingleBitPerPixel, // Glyph bitmap without hinting
- TextRenderingHintAntiAliasGridFit, // Glyph anti-alias bitmap with hinting
- TextRenderingHintAntiAlias, // Glyph anti-alias bitmap without hinting
- TextRenderingHintClearTypeGridFit // Glyph CT bitmap with hinting
- );
- TTextRenderingHint = TextRenderingHint;
-
-//---------------------------------------------------------------------------
-// StringFormatFlags
-//---------------------------------------------------------------------------
-
-//---------------------------------------------------------------------------
-// String format flags
-//
-// DirectionRightToLeft - For horizontal text, the reading order is
-// right to left. This value is called
-// the base embedding level by the Unicode
-// bidirectional engine.
-// For vertical text, columns are read from
-// right to left.
-// By default, horizontal or vertical text is
-// read from left to right.
-//
-// DirectionVertical - Individual lines of text are vertical. In
-// each line, characters progress from top to
-// bottom.
-// By default, lines of text are horizontal,
-// each new line below the previous line.
-//
-// NoFitBlackBox - Allows parts of glyphs to overhang the
-// bounding rectangle.
-// By default glyphs are first aligned
-// inside the margines, then any glyphs which
-// still overhang the bounding box are
-// repositioned to avoid any overhang.
-// For example when an italic
-// lower case letter f in a font such as
-// Garamond is aligned at the far left of a
-// rectangle, the lower part of the f will
-// reach slightly further left than the left
-// edge of the rectangle. Setting this flag
-// will ensure the character aligns visually
-// with the lines above and below, but may
-// cause some pixels outside the formatting
-// rectangle to be clipped or painted.
-//
-// DisplayFormatControl - Causes control characters such as the
-// left-to-right mark to be shown in the
-// output with a representative glyph.
-//
-// NoFontFallback - Disables fallback to alternate fonts for
-// characters not supported in the requested
-// font. Any missing characters will be
-// be displayed with the fonts missing glyph,
-// usually an open square.
-//
-// NoWrap - Disables wrapping of text between lines
-// when formatting within a rectangle.
-// NoWrap is implied when a point is passed
-// instead of a rectangle, or when the
-// specified rectangle has a zero line length.
-//
-// NoClip - By default text is clipped to the
-// formatting rectangle. Setting NoClip
-// allows overhanging pixels to affect the
-// device outside the formatting rectangle.
-// Pixels at the end of the line may be
-// affected if the glyphs overhang their
-// cells, and either the NoFitBlackBox flag
-// has been set, or the glyph extends to far
-// to be fitted.
-// Pixels above/before the first line or
-// below/after the last line may be affected
-// if the glyphs extend beyond their cell
-// ascent / descent. This can occur rarely
-// with unusual diacritic mark combinations.
-
-//---------------------------------------------------------------------------
-
-Type
-
-//---------------------------------------------------------------------------
-// String alignment flags
-//---------------------------------------------------------------------------
-
- StringAlignment = (
- // Left edge for left-to-right text,
- // right for right-to-left text,
- // and top for vertical
- StringAlignmentNear,
- StringAlignmentCenter,
- StringAlignmentFar
- );
- TStringAlignment = StringAlignment;
-
-
-//---------------------------------------------------------------------------
-// Trimming flags
-//---------------------------------------------------------------------------
-
- StringTrimming = (
- {
- #define GDIPLUS_STRINGTRIMMING_None 0 && no trimming.
- #define GDIPLUS_STRINGTRIMMING_Character 1 && nearest character.
- #define GDIPLUS_STRINGTRIMMING_Word 2 && nearest wor
- #define GDIPLUS_STRINGTRIMMING_EllipsisCharacter 3 && nearest character, ellipsis at end
- #define GDIPLUS_STRINGTRIMMING_EllipsisWord 4 && nearest word, ellipsis at end
- #define GDIPLUS_STRINGTRIMMING_EllipsisPath 5 && ellipsis in center, favouring last slash-delimited segment
- }
- StringTrimmingNone,
- StringTrimmingCharacter,
- StringTrimmingWord,
- StringTrimmingEllipsisCharacter,
- StringTrimmingEllipsisWord,
- StringTrimmingEllipsisPath
- );
- TStringTrimming = StringTrimming;
-
-//---------------------------------------------------------------------------
-// Hotkey prefix interpretation
-//---------------------------------------------------------------------------
-
- HotkeyPrefix = (
- HotkeyPrefixNone,
- HotkeyPrefixShow,
- HotkeyPrefixHide
- );
- THotkeyPrefix = HotkeyPrefix;
-
-//---------------------------------------------------------------------------
-// Flush Intention flags
-//---------------------------------------------------------------------------
-
- FlushIntention = (
- FlushIntentionFlush, // Flush all batched rendering operations
- FlushIntentionSync // Flush all batched rendering operations
- // and wait for them to complete
- );
- TFlushIntention = FlushIntention;
-
-
- //{$EXTERNALSYM ImageAbort}
- ImageAbort = function: BOOL; stdcall;
- //{$EXTERNALSYM DrawImageAbort}
- DrawImageAbort = ImageAbort;
-
-//--------------------------------------------------------------------------
-// Status return values from GDI+ methods
-//--------------------------------------------------------------------------
-type
- Status = (
- Ok,
- GenericError,
- InvalidParameter,
- OutOfMemory,
- ObjectBusy,
- InsufficientBuffer,
- NotImplemented,
- Win32Error,
- WrongState,
- Aborted,
- FileNotFound,
- ValueOverflow,
- AccessDenied,
- UnknownImageFormat,
- FontFamilyNotFound,
- FontStyleNotFound,
- NotTrueTypeFont,
- UnsupportedGdiplusVersion,
- GdiplusNotInitialized,
- PropertyNotFound,
- PropertyNotSupported
- );
- TStatus = Status;
-
-//--------------------------------------------------------------------------
-// Represents a location in a 2D coordinate system (floating-point coordinates)
-//--------------------------------------------------------------------------
-
-type
- PGPPointF = ^TGPPointF;
- TGPPointF = packed record
- X : Single;
- Y : Single;
- end;
- TPointFDynArray = array of TGPPointF;
-
- function MakePoint(X, Y: Single): TGPPointF; overload;
-
-//--------------------------------------------------------------------------
-// Represents a location in a 2D coordinate system (integer coordinates)
-//--------------------------------------------------------------------------
-
-type
- PGPPoint = ^TGPPoint;
- TGPPoint = packed record
- X : Integer;
- Y : Integer;
- end;
- TPointDynArray = array of TGPPoint;
-
- function MakePoint(X, Y: Integer): TGPPoint; overload;
-
-//--------------------------------------------------------------------------
-// Represents a rectangle in a 2D coordinate system (floating-point coordinates)
-//--------------------------------------------------------------------------
-
-type
- PGPRectF = ^TGPRectF;
- TGPRectF = packed record
- X : Single;
- Y : Single;
- Width : Single;
- Height: Single;
- end;
- TRectFDynArray = array of TGPRectF;
-
- function MakeRect(x, y, width, height: Single): TGPRectF; overload;
-
-type
- PGPRect = ^TGPRect;
- TGPRect = packed record
- X : Integer;
- Y : Integer;
- Width : Integer;
- Height: Integer;
- end;
- TRectDynArray = array of TGPRect;
-
-
-(**************************************************************************
-*
-* GDI+ Startup and Shutdown APIs
-*
-**************************************************************************)
-type
- DebugEventLevel = (
- DebugEventLevelFatal,
- DebugEventLevelWarning
- );
- TDebugEventLevel = DebugEventLevel;
-
- // Callback function that GDI+ can call, on debug builds, for assertions
- // and warnings.
-
- DebugEventProc = procedure(level: DebugEventLevel; message: PChar); stdcall;
-
- // Notification functions which the user must call appropriately if
- // "SuppressBackgroundThread" (below) is set.
-
- NotificationHookProc = function(out token: ULONG): Status; stdcall;
-
- NotificationUnhookProc = procedure(token: ULONG); stdcall;
-
- // Input structure for GdiplusStartup
-
- GdiplusStartupInput = packed record
- GdiplusVersion : Cardinal; // Must be 1
- DebugEventCallback : DebugEventProc; // Ignored on free builds
- SuppressBackgroundThread: BOOL; // FALSE unless you're prepared to call
- // the hook/unhook functions properly
- SuppressExternalCodecs : BOOL; // FALSE unless you want GDI+ only to use
- end; // its internal image codecs.
-
- TGdiplusStartupInput = GdiplusStartupInput;
- PGdiplusStartupInput = ^TGdiplusStartupInput;
-
- // Output structure for GdiplusStartup()
-
- GdiplusStartupOutput = packed record
- // The following 2 fields are NULL if SuppressBackgroundThread is FALSE.
- // Otherwise, they are functions which must be called appropriately to
- // replace the background thread.
- //
- // These should be called on the application's main message loop - i.e.
- // a message loop which is active for the lifetime of GDI+.
- // "NotificationHook" should be called before starting the loop,
- // and "NotificationUnhook" should be called after the loop ends.
-
- NotificationHook : NotificationHookProc;
- NotificationUnhook: NotificationUnhookProc;
- end;
- TGdiplusStartupOutput = GdiplusStartupOutput;
- PGdiplusStartupOutput = ^TGdiplusStartupOutput;
-
- // GDI+ initialization. Must not be called from DllMain - can cause deadlock.
- //
- // Must be called before GDI+ API's or constructors are used.
- //
- // token - may not be NULL - accepts a token to be passed in the corresponding
- // GdiplusShutdown call.
- // input - may not be NULL
- // output - may be NULL only if input->SuppressBackgroundThread is FALSE.
-
- {$EXTERNALSYM GdiplusStartup}
- function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput;
- output: PGdiplusStartupOutput): Status; stdcall;
-
- // GDI+ termination. Must be called before GDI+ is unloaded.
- // Must not be called from DllMain - can cause deadlock.
- //
- // GDI+ API's may not be called after GdiplusShutdown. Pay careful attention
- // to GDI+ object destructors.
-
- {$EXTERNALSYM GdiplusShutdown}
- procedure GdiplusShutdown(token: ULONG); stdcall;
-
-type
- PARGB = ^ARGB;
- ARGB = DWORD;
- {$EXTERNALSYM ARGB}
-
-type
-
- PGPColor = ^TGPColor;
- {$EXTERNALSYM TGPCOLOR}
- TGPColor = ARGB;
-
- function MakeColor(r, g, b: Byte): ARGB; overload;
- function MakeColor(a, r, g, b: Byte): ARGB; overload;
- function GetAlpha(color: ARGB): BYTE;
- function GetRed(color: ARGB): BYTE;
- function GetGreen(color: ARGB): BYTE;
- function GetBlue(color: ARGB): BYTE;
-
-const
- // Shift count and bit mask for A, R, G, B
- AlphaShift = 24;
- {$EXTERNALSYM AlphaShift}
- RedShift = 16;
- {$EXTERNALSYM RedShift}
- GreenShift = 8;
- {$EXTERNALSYM GreenShift}
- BlueShift = 0;
- {$EXTERNALSYM BlueShift}
-
- AlphaMask = $ff000000;
- {$EXTERNALSYM AlphaMask}
- RedMask = $00ff0000;
- {$EXTERNALSYM RedMask}
- GreenMask = $0000ff00;
- {$EXTERNALSYM GreenMask}
- BlueMask = $000000ff;
- {$EXTERNALSYM BlueMask}
-
-type
- PixelFormat = Integer;
- {$EXTERNALSYM PixelFormat}
- TPixelFormat = PixelFormat;
-
-const
- PixelFormatIndexed = $00010000; // Indexes into a palette
- {$EXTERNALSYM PixelFormatIndexed}
- PixelFormatGDI = $00020000; // Is a GDI-supported format
- {$EXTERNALSYM PixelFormatGDI}
- PixelFormatAlpha = $00040000; // Has an alpha component
- {$EXTERNALSYM PixelFormatAlpha}
- PixelFormatPAlpha = $00080000; // Pre-multiplied alpha
- {$EXTERNALSYM PixelFormatPAlpha}
- PixelFormatExtended = $00100000; // Extended color 16 bits/channel
- {$EXTERNALSYM PixelFormatExtended}
- PixelFormatCanonical = $00200000;
- {$EXTERNALSYM PixelFormatCanonical}
-
- PixelFormatUndefined = 0;
- {$EXTERNALSYM PixelFormatUndefined}
- PixelFormatDontCare = 0;
- {$EXTERNALSYM PixelFormatDontCare}
-
- PixelFormat1bppIndexed = (1 or ( 1 shl 8) or PixelFormatIndexed or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat1bppIndexed}
- PixelFormat4bppIndexed = (2 or ( 4 shl 8) or PixelFormatIndexed or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat4bppIndexed}
- PixelFormat8bppIndexed = (3 or ( 8 shl 8) or PixelFormatIndexed or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat8bppIndexed}
- PixelFormat16bppGrayScale = (4 or (16 shl 8) or PixelFormatExtended);
- {$EXTERNALSYM PixelFormat16bppGrayScale}
- PixelFormat16bppRGB555 = (5 or (16 shl 8) or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat16bppRGB555}
- PixelFormat16bppRGB565 = (6 or (16 shl 8) or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat16bppRGB565}
- PixelFormat16bppARGB1555 = (7 or (16 shl 8) or PixelFormatAlpha or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat16bppARGB1555}
- PixelFormat24bppRGB = (8 or (24 shl 8) or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat24bppRGB}
- PixelFormat32bppRGB = (9 or (32 shl 8) or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat32bppRGB}
- PixelFormat32bppARGB = (10 or (32 shl 8) or PixelFormatAlpha or PixelFormatGDI or PixelFormatCanonical);
- {$EXTERNALSYM PixelFormat32bppARGB}
- PixelFormat32bppPARGB = (11 or (32 shl 8) or PixelFormatAlpha or PixelFormatPAlpha or PixelFormatGDI);
- {$EXTERNALSYM PixelFormat32bppPARGB}
- PixelFormat48bppRGB = (12 or (48 shl 8) or PixelFormatExtended);
- {$EXTERNALSYM PixelFormat48bppRGB}
- PixelFormat64bppARGB = (13 or (64 shl 8) or PixelFormatAlpha or PixelFormatCanonical or PixelFormatExtended);
- {$EXTERNALSYM PixelFormat64bppARGB}
- PixelFormat64bppPARGB = (14 or (64 shl 8) or PixelFormatAlpha or PixelFormatPAlpha or PixelFormatExtended);
- {$EXTERNALSYM PixelFormat64bppPARGB}
- PixelFormatMax = 15;
- {$EXTERNALSYM PixelFormatMax}
-
-type
-
-{$IFDEF DELPHI6_UP}
- RotateFlipType = (
- RotateNoneFlipNone = 0,
- Rotate90FlipNone = 1,
- Rotate180FlipNone = 2,
- Rotate270FlipNone = 3,
-
- RotateNoneFlipX = 4,
- Rotate90FlipX = 5,
- Rotate180FlipX = 6,
- Rotate270FlipX = 7,
-
- RotateNoneFlipY = Rotate180FlipX,
- Rotate90FlipY = Rotate270FlipX,
- Rotate180FlipY = RotateNoneFlipX,
- Rotate270FlipY = Rotate90FlipX,
-
- RotateNoneFlipXY = Rotate180FlipNone,
- Rotate90FlipXY = Rotate270FlipNone,
- Rotate180FlipXY = RotateNoneFlipNone,
- Rotate270FlipXY = Rotate90FlipNone
- );
- TRotateFlipType = RotateFlipType;
-{$ELSE}
-
- RotateFlipType = (
- RotateNoneFlipNone, // = 0,
- Rotate90FlipNone, // = 1,
- Rotate180FlipNone, // = 2,
- Rotate270FlipNone, // = 3,
-
- RotateNoneFlipX, // = 4,
- Rotate90FlipX, // = 5,
- Rotate180FlipX, // = 6,
- Rotate270FlipX // = 7,
- );
- const
- RotateNoneFlipY = Rotate180FlipX;
- Rotate90FlipY = Rotate270FlipX;
- Rotate180FlipY = RotateNoneFlipX;
- Rotate270FlipY = Rotate90FlipX;
-
- RotateNoneFlipXY = Rotate180FlipNone;
- Rotate90FlipXY = Rotate270FlipNone;
- Rotate180FlipXY = RotateNoneFlipNone;
- Rotate270FlipXY = Rotate90FlipNone;
-
-type
- TRotateFlipType = RotateFlipType;
-{$ENDIF}
-
-//----------------------------------------------------------------------------
-// Color Adjust Type
-//----------------------------------------------------------------------------
-
- //{$EXTERNALSYM ColorAdjustType}
- ColorAdjustType = (
- ColorAdjustTypeDefault,
- ColorAdjustTypeBitmap,
- ColorAdjustTypeBrush,
- ColorAdjustTypePen,
- ColorAdjustTypeText,
- ColorAdjustTypeCount,
- ColorAdjustTypeAny // Reserved
- );
- TColorAdjustType = ColorAdjustType;
-
-//---------------------------------------------------------------------------
-// Image encoder parameter related types
-//---------------------------------------------------------------------------
-
- //{$EXTERNALSYM EncoderParameterValueType}
- EncoderParameterValueType = Integer;
- const
- EncoderParameterValueTypeByte : Integer = 1; // 8-bit unsigned int
- EncoderParameterValueTypeASCII : Integer = 2; // 8-bit byte containing one 7-bit ASCII
- // code. NULL terminated.
- EncoderParameterValueTypeShort : Integer = 3; // 16-bit unsigned int
- EncoderParameterValueTypeLong : Integer = 4; // 32-bit unsigned int
- EncoderParameterValueTypeRational : Integer = 5; // Two Longs. The first Long is the
- // numerator, the second Long expresses the
- // denomintor.
- EncoderParameterValueTypeLongRange : Integer = 6; // Two longs which specify a range of
- // integer values. The first Long specifies
- // the lower end and the second one
- // specifies the higher end. All values
- // are inclusive at both ends
- EncoderParameterValueTypeUndefined : Integer = 7; // 8-bit byte that can take any value
- // depending on field definition
- EncoderParameterValueTypeRationalRange : Integer = 8; // Two Rationals. The first Rational
- // specifies the lower end and the second
- // specifies the higher end. All values
- // are inclusive at both ends
-type
- TEncoderParameterValueType = EncoderParameterValueType;
-
- //---------------------------------------------------------------------------
-// Image encoder value types
-//---------------------------------------------------------------------------
-
- //{$EXTERNALSYM EncoderValue}
- EncoderValue = (
- EncoderValueColorTypeCMYK,
- EncoderValueColorTypeYCCK,
- EncoderValueCompressionLZW,
- EncoderValueCompressionCCITT3,
- EncoderValueCompressionCCITT4,
- EncoderValueCompressionRle,
- EncoderValueCompressionNone,
- EncoderValueScanMethodInterlaced,
- EncoderValueScanMethodNonInterlaced,
- EncoderValueVersionGif87,
- EncoderValueVersionGif89,
- EncoderValueRenderProgressive,
- EncoderValueRenderNonProgressive,
- EncoderValueTransformRotate90,
- EncoderValueTransformRotate180,
- EncoderValueTransformRotate270,
- EncoderValueTransformFlipHorizontal,
- EncoderValueTransformFlipVertical,
- EncoderValueMultiFrame,
- EncoderValueLastFrame,
- EncoderValueFlush,
- EncoderValueFrameDimensionTime,
- EncoderValueFrameDimensionResolution,
- EncoderValueFrameDimensionPage
- );
- TEncoderValue = EncoderValue;
-
-
-//---------------------------------------------------------------------------
-// Encoder Parameter structure
-//---------------------------------------------------------------------------
-
- //{$EXTERNALSYM EncoderParameter}
- EncoderParameter = packed record
- Guid : TGUID; // GUID of the parameter
- NumberOfValues : ULONG; // Number of the parameter values
- Type_ : ULONG; // Value type, like ValueTypeLONG etc.
- Value : Pointer; // A pointer to the parameter values
- end;
- TEncoderParameter = EncoderParameter;
- PEncoderParameter = ^TEncoderParameter;
-
-//---------------------------------------------------------------------------
-// Encoder Parameters structure
-//---------------------------------------------------------------------------
-
- //{$EXTERNALSYM EncoderParameters}
- EncoderParameters = packed record
- Count : UINT; // Number of parameters in this structure
- Parameter : array[0..0] of TEncoderParameter; // Parameter values
- end;
- TEncoderParameters = EncoderParameters;
- PEncoderParameters = ^TEncoderParameters;
-
-
-//--------------------------------------------------------------------------
-// ImageCodecInfo structure
-//--------------------------------------------------------------------------
-
-type
- //{$EXTERNALSYM ImageCodecInfo}
- ImageCodecInfo = packed record
- Clsid : TGUID;
- FormatID : TGUID;
- CodecName : PWCHAR;
- DllName : PWCHAR;
- FormatDescription : PWCHAR;
- FilenameExtension : PWCHAR;
- MimeType : PWCHAR;
- Flags : DWORD;
- Version : DWORD;
- SigCount : DWORD;
- SigSize : DWORD;
- SigPattern : PBYTE;
- SigMask : PBYTE;
- end;
- TImageCodecInfo = ImageCodecInfo;
- PImageCodecInfo = ^TImageCodecInfo;
-
-
-const
-//---------------------------------------------------------------------------
-// Encoder parameter sets
-//---------------------------------------------------------------------------
-
- EncoderCompression : TGUID = '{e09d739d-ccd4-44ee-8eba-3fbf8be4fc58}';
- {$EXTERNALSYM EncoderCompression}
- EncoderColorDepth : TGUID = '{66087055-ad66-4c7c-9a18-38a2310b8337}';
- {$EXTERNALSYM EncoderColorDepth}
- EncoderScanMethod : TGUID = '{3a4e2661-3109-4e56-8536-42c156e7dcfa}';
- {$EXTERNALSYM EncoderScanMethod}
- EncoderVersion : TGUID = '{24d18c76-814a-41a4-bf53-1c219cccf797}';
- {$EXTERNALSYM EncoderVersion}
- EncoderRenderMethod : TGUID = '{6d42c53a-229a-4825-8bb7-5c99e2b9a8b8}';
- {$EXTERNALSYM EncoderRenderMethod}
- EncoderQuality : TGUID = '{1d5be4b5-fa4a-452d-9cdd-5db35105e7eb}';
- {$EXTERNALSYM EncoderQuality}
- EncoderTransformation : TGUID = '{8d0eb2d1-a58e-4ea8-aa14-108074b7b6f9}';
- {$EXTERNALSYM EncoderTransformation}
- EncoderLuminanceTable : TGUID = '{edb33bce-0266-4a77-b904-27216099e717}';
- {$EXTERNALSYM EncoderLuminanceTable}
- EncoderChrominanceTable : TGUID = '{f2e455dc-09b3-4316-8260-676ada32481c}';
- {$EXTERNALSYM EncoderChrominanceTable}
- EncoderSaveFlag : TGUID = '{292266fc-ac40-47bf-8cfc-a85b89a655de}';
- {$EXTERNALSYM EncoderSaveFlag}
-
-
-//---------------------------------------------------------------------------
-// Private GDI+ classes for internal type checking
-//---------------------------------------------------------------------------
-
-type
- GpGraphics = Pointer;
-
- GpBrush = Pointer;
- GpSolidFill = Pointer;
- GpLineGradient = Pointer;
- GpPathGradient = Pointer;
-
- GpPen = Pointer;
-
- GpImage = Pointer;
- GpBitmap = Pointer;
- GpImageAttributes = Pointer;
-
- GpPath = Pointer;
- GpRegion = Pointer;
-
- GpFontFamily = Pointer;
- GpFont = Pointer;
- GpStringFormat = Pointer;
- GpFontCollection = Pointer;
-
- GpStatus = TStatus;
- GpFillMode = TFillMode;
- GpWrapMode = TWrapMode;
- GpUnit = TUnit;
- GpPointF = PGPPointF;
- GpPoint = PGPPoint;
- GpRectF = PGPRectF;
- GpRect = PGPRect;
- GpDashStyle = TDashStyle;
- GpLineCap = TLineCap;
- GpFlushIntention = TFlushIntention;
-
- function GdipCreatePath(brushMode: GPFILLMODE;
- out path: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreatePath}
-
- (* function GdipClonePath(path: GPPATH;
- out clonePath: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipClonePath}
- *)
- function GdipDeletePath(path: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeletePath}
- (*
- function GdipStartPathFigure(path: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipStartPathFigure}
- *)
- function GdipClosePathFigure(path: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipClosePathFigure}
-
- function GdipAddPathLine(path: GPPATH;
- x1, y1, x2, y2: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathLine}
-
- function GdipAddPathArc(path: GPPATH; x, y, width, height, startAngle,
- sweepAngle: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathArc}
-
- function GdipAddPathEllipse(path: GPPATH; x: Single; y: Single;
- width: Single; height: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathEllipse}
-
- function GdipAddPathPie(path: GPPATH; x: Single; y: Single; width: Single;
- height: Single; startAngle: Single; sweepAngle: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathPie}
-
-//----------------------------------------------------------------------------
-// Brush APIs
-//----------------------------------------------------------------------------
-
- function GdipDeleteBrush(brush: GPBRUSH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeleteBrush}
-
-//----------------------------------------------------------------------------
-// SolidBrush APIs
-//----------------------------------------------------------------------------
-
- function GdipCreateSolidFill(color: ARGB;
- out brush: GPSOLIDFILL): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateSolidFill}
-
-//----------------------------------------------------------------------------
-// LineBrush APIs
-//----------------------------------------------------------------------------
-
- function GdipCreateLineBrushFromRect(rect: GPRECTF; color1: ARGB;
- color2: ARGB; mode: LINEARGRADIENTMODE; wrapMode: GPWRAPMODE;
- out lineGradient: GPLINEGRADIENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateLineBrushFromRect}
-
- function GdipCreateLineBrushFromRectI(rect: GPRECT; color1: ARGB;
- color2: ARGB; mode: LINEARGRADIENTMODE; wrapMode: GPWRAPMODE;
- out lineGradient: GPLINEGRADIENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateLineBrushFromRectI}
-
- function GdipCreateLineBrushFromRectWithAngle(rect: GPRECTF; color1: ARGB;
- color2: ARGB; angle: Single; isAngleScalable: Bool; wrapMode: GPWRAPMODE;
- out lineGradient: GPLINEGRADIENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateLineBrushFromRectWithAngle}
-
-//----------------------------------------------------------------------------
-// PathGradientBrush APIs
-//----------------------------------------------------------------------------
-
- function GdipCreatePathGradient(points: GPPOINTF; count: Integer;
- wrapMode: GPWRAPMODE; out polyGradient: GPPATHGRADIENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreatePathGradient}
-
- function GdipCreatePathGradientFromPath(path: GPPATH;
- out polyGradient: GPPATHGRADIENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreatePathGradientFromPath}
-
- function GdipGetPathGradientCenterColor(brush: GPPATHGRADIENT;
- out colors: ARGB): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPathGradientCenterColor}
-
- function GdipSetPathGradientCenterColor(brush: GPPATHGRADIENT;
- colors: ARGB): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetPathGradientCenterColor}
-
- function GdipGetPathGradientSurroundColorsWithCount(brush: GPPATHGRADIENT;
- color: PARGB; var count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPathGradientSurroundColorsWithCount}
-
- function GdipSetPathGradientSurroundColorsWithCount(brush: GPPATHGRADIENT;
- color: PARGB; var count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetPathGradientSurroundColorsWithCount}
-
- function GdipGetPathGradientCenterPoint(brush: GPPATHGRADIENT;
- points: GPPOINTF): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPathGradientCenterPoint}
-
- function GdipGetPathGradientCenterPointI(brush: GPPATHGRADIENT;
- points: GPPOINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPathGradientCenterPointI}
-
- function GdipSetPathGradientCenterPoint(brush: GPPATHGRADIENT;
- points: GPPOINTF): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetPathGradientCenterPoint}
-
- function GdipSetPathGradientCenterPointI(brush: GPPATHGRADIENT;
- points: GPPOINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetPathGradientCenterPointI}
-
- function GdipGetPathGradientPointCount(brush: GPPATHGRADIENT;
- var count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPathGradientPointCount}
-
- function GdipGetPathGradientSurroundColorCount(brush: GPPATHGRADIENT;
- var count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPathGradientSurroundColorCount}
-
-//----------------------------------------------------------------------------
-// Pen APIs
-//----------------------------------------------------------------------------
-
- function GdipCreatePen1(color: ARGB; width: Single; unit_: GPUNIT;
- out pen: GPPEN): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreatePen1}
-
- function GdipDeletePen(pen: GPPEN): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeletePen}
-
-//----------------------------------------------------------------------------
-// Graphics APIs
-//----------------------------------------------------------------------------
-
- function GdipFlush(graphics: GPGRAPHICS;
- intention: GPFLUSHINTENTION): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipFlush}
-
- function GdipCreateFromHDC(hdc: HDC;
- out graphics: GPGRAPHICS): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateFromHDC}
-
- function GdipGetImageGraphicsContext(image: GPIMAGE;
- out graphics: GPGRAPHICS): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageGraphicsContext}
-
-
- function GdipDeleteGraphics(graphics: GPGRAPHICS): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeleteGraphics}
-
- function GdipGetDC(graphics: GPGRAPHICS; var hdc: HDC): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetDC}
-
- function GdipReleaseDC(graphics: GPGRAPHICS; hdc: HDC): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipReleaseDC}
-
- function GdipSetSmoothingMode(graphics: GPGRAPHICS;
- smoothingMode: SMOOTHINGMODE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetSmoothingMode}
-
- function GdipGetSmoothingMode(graphics: GPGRAPHICS;
- var smoothingMode: SMOOTHINGMODE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetSmoothingMode}
-
- function GdipSetTextRenderingHint(graphics: GPGRAPHICS;
- mode: TEXTRENDERINGHINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetTextRenderingHint}
-
- function GdipGetTextRenderingHint(graphics: GPGRAPHICS;
- var mode: TEXTRENDERINGHINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetTextRenderingHint}
-
- function GdipDrawRectangle(graphics: GPGRAPHICS; pen: GPPEN; x: Single;
- y: Single; width: Single; height: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawRectangle}
-
- function GdipDrawRectangleI(graphics: GPGRAPHICS; pen: GPPEN; x: Integer;
- y: Integer; width: Integer; height: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawRectangleI}
-
-
- function GdipDrawPath(graphics: GPGRAPHICS; pen: GPPEN;
- path: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawPath}
-
- function GdipFillRectangle(graphics: GPGRAPHICS; brush: GPBRUSH; x: Single;
- y: Single; width: Single; height: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipFillRectangle}
-
- function GdipFillPath(graphics: GPGRAPHICS; brush: GPBRUSH;
- path: GPPATH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipFillPath}
-
- function GdipDrawImageI(graphics: GPGRAPHICS; image: GPIMAGE; x: Integer;
- y: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawImageI}
-
- function GdipDrawImage(graphics: GPGRAPHICS; image: GPIMAGE; x: Single;
- y: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawImage}
-
- function GdipDrawImageRect(graphics: GPGRAPHICS; image: GPIMAGE; x: Single;
- y: Single; width: Single; height: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawImageRect}
-
- function GdipDrawImageRectI(graphics: GPGRAPHICS; image: GPIMAGE; x: Integer;
- y: Integer; width: Integer; height: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawImageRectI}
-
- function GdipGetImageRawFormat(image: GPIMAGE;
- format: PGUID): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageRawFormat}
-
- function GdipGetPenDashStyle(pen: GPPEN;
- out dashstyle: GPDASHSTYLE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetPenDashStyle}
-
- function GdipSetPenDashStyle(pen: GPPEN;
- dashstyle: GPDASHSTYLE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetPenDashStyle}
-
- function GdipSetClipRect(graphics: GPGRAPHICS; x: Single; y: Single;
- width: Single; height: Single; combineMode: COMBINEMODE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetClipRect}
-
- function GdipSetClipRegion(graphics: GPGRAPHICS; region: GPREGION;
- combineMode: COMBINEMODE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetClipRegion}
-
- function GdipCreateRegionRect(rect: GPRECTF;
- out region: GPREGION): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateRegionRect}
-
- function GdipCreateRegionPath(path: GPPATH;
- out region: GPREGION): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateRegionPath}
-
- function GdipDeleteRegion(region: GPREGION): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeleteRegion}
-
- function GdipCombineRegionPath(region: GPREGION; path: GPPATH;
- combineMode: COMBINEMODE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCombineRegionPath}
-
- function GdipCombineRegionRegion(region: GPREGION; region2: GPREGION;
- combineMode: COMBINEMODE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCombineRegionRegion}
-
-//----------------------------------------------------------------------------
-// FontFamily APIs
-//----------------------------------------------------------------------------
-
- function GdipCreateFontFamilyFromName(name: PWCHAR;
- fontCollection: GPFONTCOLLECTION;
- out FontFamily: GPFONTFAMILY): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateFontFamilyFromName}
-
- function GdipDeleteFontFamily(FontFamily: GPFONTFAMILY): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeleteFontFamily}
-
-//----------------------------------------------------------------------------
-// Font APIs
-//----------------------------------------------------------------------------
-
- function GdipCreateFont(fontFamily: GPFONTFAMILY; emSize: Single;
- style: Integer; unit_: Integer; out font: GPFONT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateFont}
-
- function GdipDeleteFont(font: GPFONT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeleteFont}
-
-//----------------------------------------------------------------------------
-// Image APIs
-//----------------------------------------------------------------------------
-
- function GdipGetImageDecodersSize(out numDecoders: UINT;
- out size: UINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageDecodersSize}
-
- function GdipGetImageDecoders(numDecoders: UINT; size: UINT;
- decoders: PIMAGECODECINFO): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageDecoders}
-
- function GdipGetImageEncoders(numEncoders: UINT; size: UINT;
- encoders: PIMAGECODECINFO): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageEncoders}
-
- function GdipGetImageEncodersSize(out numEncoders: UINT;
- out size: UINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageEncodersSize}
-
- function GdipSaveImageToFile(image: GPIMAGE;
- filename: PWCHAR;
- clsidEncoder: PGUID;
- encoderParams: PENCODERPARAMETERS): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSaveImageToFile}
-
- function GdipLoadImageFromStream(stream: ISTREAM;
- out image: GPIMAGE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipLoadImageFromStream}
-
- function GdipLoadImageFromFileICM(filename: PWCHAR;
- out image: GPIMAGE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipLoadImageFromFileICM}
-
- function GdipLoadImageFromFile(filename: PWCHAR;
- out image: GPIMAGE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipLoadImageFromFile}
-
- function GdipLoadImageFromStreamICM(stream: ISTREAM;
- out image: GPIMAGE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipLoadImageFromStreamICM}
-
- function GdipDisposeImage(image: GPIMAGE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDisposeImage}
-
- function GdipGetImageWidth(image: GPIMAGE; var width: UINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageWidth}
-
- function GdipGetImageHeight(image: GPIMAGE; var height: UINT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageHeight}
-
- function GdipGetImageHorizontalResolution(image: GPIMAGE; var resolution: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageHorizontalResolution}
-
- function GdipGetImageVerticalResolution(image: GPIMAGE; var resolution: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetImageVerticalResolution}
-
-
-//----------------------------------------------------------------------------
-// Text APIs
-//----------------------------------------------------------------------------
-
- function GdipDrawString(graphics: GPGRAPHICS; string_: PWCHAR;
- length: Integer; font: GPFONT; layoutRect: PGPRectF;
- stringFormat: GPSTRINGFORMAT; brush: GPBRUSH): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawString}
-
- function GdipMeasureString(graphics: GPGRAPHICS; string_: PWCHAR;
- length: Integer; font: GPFONT; layoutRect: PGPRectF;
- stringFormat: GPSTRINGFORMAT; boundingBox: PGPRectF;
- codepointsFitted: PInteger; linesFilled: PInteger): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipMeasureString}
-
- function GdipSetStringFormatHotkeyPrefix(format: GPSTRINGFORMAT;
- hotkeyPrefix: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetStringFormatHotkeyPrefix}
-
- function GdipGetStringFormatHotkeyPrefix(format: GPSTRINGFORMAT;
- out hotkeyPrefix: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetStringFormatHotkeyPrefix}
-
-//----------------------------------------------------------------------------
-// String format APIs
-//----------------------------------------------------------------------------
-
- function GdipCreateStringFormat(formatAttributes: Integer; language: LANGID;
- out format: GPSTRINGFORMAT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateStringFormat}
-
- function GdipDeleteStringFormat(format: GPSTRINGFORMAT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDeleteStringFormat}
-
- function GdipCloneStringFormat(format: GPSTRINGFORMAT;
- out newFormat: GPSTRINGFORMAT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCloneStringFormat}
-
- function GdipSetStringFormatAlign(format: GPSTRINGFORMAT;
- align: STRINGALIGNMENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetStringFormatAlign}
-
- function GdipGetStringFormatAlign(format: GPSTRINGFORMAT;
- out align: STRINGALIGNMENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetStringFormatAlign}
-
- function GdipSetStringFormatLineAlign(format: GPSTRINGFORMAT;
- align: STRINGALIGNMENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetStringFormatLineAlign}
-
- function GdipGetStringFormatLineAlign(format: GPSTRINGFORMAT;
- out align: STRINGALIGNMENT): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetStringFormatLineAlign}
-
-
- function GdipSetStringFormatTrimming(format: GPSTRINGFORMAT;
- trimming: STRINGTRIMMING): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetStringFormatTrimming}
-
- function GdipGetStringFormatTrimming(format: GPSTRINGFORMAT;
- out trimming: STRINGTRIMMING): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetStringFormatTrimming}
-
- function GdipSetCompositingQuality(graphics: GPGRAPHICS;
- compositingQuality: COMPOSITINGQUALITY): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetCompositingQuality}
-
- function GdipGetCompositingQuality(graphics: GPGRAPHICS;
- var compositingQuality: COMPOSITINGQUALITY): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipGetCompositingQuality}
-
- function GdipImageRotateFlip(image: GPIMAGE; rfType: ROTATEFLIPTYPE): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipImageRotateFlip}
-
- function GdipCreateBitmapFromStreamICM(stream: ISTREAM;
- out bitmap: GPBITMAP): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateBitmapFromStreamICM}
-
- function GdipCreateBitmapFromStream(stream: ISTREAM;
- out bitmap: GPBITMAP): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateBitmapFromStream}
-
- function GdipCreateBitmapFromScan0(width: Integer; height: Integer;
- stride: Integer; format: PIXELFORMAT; scan0: PBYTE;
- out bitmap: GPBITMAP): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateBitmapFromScan0}
-
- function GdipBitmapGetPixel(bitmap: GPBITMAP; x: Integer; y: Integer;
- var color: ARGB): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipBitmapGetPixel}
-
- function GdipBitmapSetPixel(bitmap: GPBITMAP; x: Integer; y: Integer;
- color: ARGB): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipBitmapSetPixel}
-
- function GdipBitmapSetResolution(bitmap: GPBITMAP; xdpi: Single;
- ydpi: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipBitmapSetResolution}
-
- function GdipCreateImageAttributes(
- out imageattr: GPIMAGEATTRIBUTES): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipCreateImageAttributes}
-
- function GdipDisposeImageAttributes(
- imageattr: GPIMAGEATTRIBUTES): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDisposeImageAttributes}
-
- function GdipSetImageAttributesColorKeys(imageattr: GPIMAGEATTRIBUTES;
- type_: COLORADJUSTTYPE; enableFlag: Bool; colorLow: ARGB;
- colorHigh: ARGB): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetImageAttributesColorKeys}
-
- function GdipSetPenEndCap(pen: GPPEN; endCap: GPLINECAP): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipSetPenEndCap}
-
- function GdipAddPathLine2I(path: GPPATH; points: GPPOINT;
- count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathLine2I}
-
-
- function GdipAddPathPolygon(path: GPPATH; points: GPPOINTF;
- count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathPolygon}
-
- function GdipAddPathPolygonI(path: GPPATH; points: GPPOINT;
- count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathPolygonI}
-
- function GdipAddPathCurveI(path: GPPATH; points: GPPOINT;
- count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathCurveI}
-
- function GdipAddPathCurve(path: GPPATH; points: GPPOINTF;
- count: Integer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathCurve}
-
- function GdipAddPathCurve2I(path: GPPATH; points: GPPOINT; count: Integer;
- tension: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathCurve2I}
-
- function GdipResetClip(graphics: GPGRAPHICS): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipResetClip}
-
- function GdipAddPathBezier(path: GPPATH;
- x1, y1, x2, y2, x3, y3, x4, y4: Single): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipAddPathBezier}
-
- function GdipDrawImageRectRect(graphics: GPGRAPHICS; image: GPIMAGE;
- dstx: Single; dsty: Single; dstwidth: Single; dstheight: Single;
- srcx: Single; srcy: Single; srcwidth: Single; srcheight: Single;
- srcUnit: GPUNIT; imageAttributes: GPIMAGEATTRIBUTES;
- callback: DRAWIMAGEABORT; callbackData: Pointer): GPSTATUS; stdcall;
- {$EXTERNALSYM GdipDrawImageRectRect}
-
-//***************************************************************************
-//---------------------------------------------------------------------------
-// GDI+ classes for forward reference
-//---------------------------------------------------------------------------
-
-type
- TGPGraphics = class;
- TGPPen = class;
- TGPBrush = class;
- TGPFontFamily = class;
- TGPGraphicsPath = class;
- TGPSolidBrush = class;
- TGPLinearGradientBrush = class;
- TGPPathGradientBrush = class;
- TGPFont = class;
- TGPFontCollection = class;
-
-//------------------------------------------------------------------------------
-// GPRegion
-//------------------------------------------------------------------------------
- TGPRegion = class(TGdiplusBase)
- protected
- nativeRegion: GpRegion;
- lastResult: TStatus;
- function SetStatus(status: TStatus): TStatus;
- procedure SetNativeRegion(nativeRegion: GpRegion);
- public
- constructor Create(rect: TGPRectF); reintroduce; overload;
- constructor Create(path: TGPGraphicsPath); reintroduce; overload;
- destructor Destroy; override;
- function Exclude(path: TGPGraphicsPath): TStatus; overload;
- function Union(region: TGPRegion): TStatus; overload;
- end;
-
-//--------------------------------------------------------------------------
-// FontFamily
-//--------------------------------------------------------------------------
-
- TGPFontFamily = class(TGdiplusBase)
- protected
- nativeFamily: GpFontFamily;
- lastResult: TStatus;
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create(nativeOrig: GpFontFamily; status: TStatus); reintroduce; overload;
- constructor Create(name: WideString; fontCollection: TGPFontCollection = nil); reintroduce; overload;
- destructor Destroy; override;
- property Status: TStatus read lastResult;
- end;
-
-//--------------------------------------------------------------------------
-// Font Collection
-//--------------------------------------------------------------------------
-
- TGPFontCollection = class(TGdiplusBase)
- protected
- nativeFontCollection: GpFontCollection;
- lastResult: TStatus;
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create;
- destructor Destroy; override;
- end;
-
-//--------------------------------------------------------------------------
-// TFont
-//--------------------------------------------------------------------------
-
- TGPFont = class(TGdiplusBase)
- protected
- nativeFont: GpFont;
- lastResult: TStatus;
- procedure SetNativeFont(Font: GpFont);
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create(font: GpFont; status: TStatus); reintroduce; overload;
- constructor Create(family: TGPFontFamily; emSize: Single;
- style: TFontStyle = FontStyleRegular;
- unit_: TUnit = UnitPoint); reintroduce; overload;
- destructor Destroy; override;
- property Status: TStatus read lastResult;
- end;
-
-(**************************************************************************\
-*
-* GDI+ Brush class
-*
-\**************************************************************************)
-
- //--------------------------------------------------------------------------
- // Abstract base class for various brush types
- //--------------------------------------------------------------------------
-
- TGPBrush = class(TGdiplusBase)
- protected
- nativeBrush: GpBrush;
- lastResult: TStatus;
- procedure SetNativeBrush(nativeBrush: GpBrush);
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create(nativeBrush: GpBrush; status: TStatus); reintroduce; overload;
- constructor Create; overload;
- destructor Destroy; override;
- end;
-
- //--------------------------------------------------------------------------
- // Solid Fill Brush Object
- //--------------------------------------------------------------------------
-
- TGPSolidBrush = class(TGPBrush)
- public
- constructor Create(color: TGPColor); reintroduce; overload;
- constructor Create; reintroduce; overload;
- end;
-
- //--------------------------------------------------------------------------
- // Linear Gradient Brush Object
- //--------------------------------------------------------------------------
-
- TGPLinearGradientBrush = class(TGPBrush)
- public
- constructor Create; reintroduce; overload;
- constructor Create(rect: TGPRectF; color1, color2: TGPColor;
- mode: TLinearGradientMode); reintroduce; overload;
- constructor Create(rect: TGPRect; color1, color2: TGPColor;
- mode: TLinearGradientMode); reintroduce; overload;
- end;
-
-(**************************************************************************\
-*
-* GDI+ Pen class
-*
-\**************************************************************************)
-
-//--------------------------------------------------------------------------
-// Pen class
-//--------------------------------------------------------------------------
-
- TGPPen = class(TGdiplusBase)
- protected
- nativePen: GpPen;
- lastResult: TStatus;
- procedure SetNativePen(nativePen: GpPen);
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create(nativePen: GpPen; status: TStatus); reintroduce; overload;
- constructor Create(color: TGPColor; width: Single = 1.0); reintroduce; overload;
- destructor Destroy; override;
- function GetDashStyle: TDashStyle;
- function SetDashStyle(dashStyle: TDashStyle): TStatus;
- function SetEndCap(endCap: TLineCap): TStatus;
- end;
-
-(**************************************************************************\
-*
-* GDI+ StringFormat class
-*
-\**************************************************************************)
-
- TGPStringFormat = class(TGdiplusBase)
- protected
- nativeFormat: GpStringFormat;
- lastError: TStatus;
- function SetStatus(newStatus: GpStatus): TStatus;
- procedure Assign(source: TGPStringFormat);
- public
- constructor Create(clonedStringFormat: GpStringFormat; status: TStatus); reintroduce; overload;
- constructor Create(formatFlags: Integer = 0; language: LANGID = LANG_NEUTRAL); reintroduce; overload;
- destructor Destroy; override;
- function SetAlignment(align: TStringAlignment): TStatus;
- function GetAlignment: TStringAlignment;
- function SetLineAlignment(align: TStringAlignment): TStatus;
- function GetLineAlignment: TStringAlignment;
- function SetTrimming(trimming: TStringTrimming): TStatus;
- function GetTrimming: TStringTrimming;
- function SetHotkeyPrefix(hotkeyPrefix: THotkeyPrefix): TStatus;
- function GetHotkeyPrefix: THotkeyPrefix;
-
- end;
-
-(**************************************************************************\
-*
-* GDI+ Graphics Path class
-*
-\**************************************************************************)
-
- TGPGraphicsPath = class(TGdiplusBase)
- protected
- nativePath: GpPath;
- lastResult: TStatus;
- procedure SetNativePath(nativePath: GpPath);
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create(nativePath: GpPath); reintroduce; overload;
- constructor Create(fillMode: TFillMode = FillModeAlternate); reintroduce; overload;
- destructor Destroy; override;
-
- function CloseFigure: TStatus;
-
- function AddLine(const pt1, pt2: TGPPointF): TStatus; overload;
- function AddLine(x1, y1, x2, y2: Single): TStatus; overload;
- function AddLines(points: PGPPoint; count: Integer): TStatus; overload;
-
- function AddArc(rect: TGPRectF; startAngle, sweepAngle: Single): TStatus; overload;
- function AddArc(x, y, width, height, startAngle, sweepAngle: Single): TStatus; overload;
-
- function AddEllipse(rect: TGPRectF): TStatus; overload;
- function AddEllipse(x, y, width, height: Single): TStatus; overload;
-
- function AddPie(rect: TGPRectF; startAngle, sweepAngle: Single): TStatus; overload;
- function AddPie(x, y, width, height, startAngle, sweepAngle: Single): TStatus; overload;
-
- function AddPolygon(points: PGPPointF; count: Integer): TStatus; overload;
- function AddPolygon(points: PGPPoint; count: Integer): TStatus; overload;
-
-
- function AddCurve(points: PGPPointF; count: Integer): TStatus; overload;
- function AddCurve(points: PGPPoint; count: Integer): TStatus; overload;
- function AddCurve(points: PGPPoint; count: Integer; tension: Single): TStatus; overload;
-
- function AddBezier(pt1, pt2, pt3, pt4: TGPPoint): TStatus; overload;
- function AddBezier(pt1, pt2, pt3, pt4: TGPPointF): TStatus; overload;
- function AddBezier(x1, y1, x2, y2, x3, y3, x4, y4: Single): TStatus; overload;
- end;
-
-//--------------------------------------------------------------------------
-// Path Gradient Brush
-//--------------------------------------------------------------------------
-
- TGPPathGradientBrush = class(TGPBrush)
- public
- {constructor Create(points: PGPPointF; count: Integer;
- wrapMode: TWrapMode = WrapModeClamp); reintroduce; overload; }
- constructor Create(path: TGPGraphicsPath); reintroduce; //overload;
- function GetCenterColor(out Color: TGPColor): TStatus;
- function SetCenterColor(color: TGPColor): TStatus;
- function GetPointCount: Integer;
- function GetSurroundColors(colors: PARGB; var count: Integer): TStatus;
- function SetSurroundColors(colors: PARGB; var count: Integer): TStatus;
- function GetCenterPoint(out point: TGPPointF): TStatus; overload;
- function GetCenterPoint(out point: TGPPoint): TStatus; overload;
- function SetCenterPoint(point: TGPPointF): TStatus; overload;
- function SetCenterPoint(point: TGPPoint): TStatus; overload;
- end;
-
-(**************************************************************************\
-* TGPImage
-***************************************************************************)
- TGPImageFormat = (ifUndefined, ifMemoryBMP, ifBMP, ifEMF, ifWMF, ifJPEG,
- ifPNG, ifGIF, ifTIFF, ifEXIF, ifIcon);
-
- TGPImage = class(TGdiplusBase)
- protected
- nativeImage: GpImage;
- lastResult: TStatus;
- loadStatus: TStatus;
- procedure SetNativeImage(nativeImage: GpImage);
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create(nativeImage: GpImage; status: TStatus); reintroduce; overload;
- constructor Create(filename: WideString; useEmbeddedColorManagement: BOOL = FALSE); reintroduce; overload;
- constructor Create(stream: IStream; useEmbeddedColorManagement: BOOL = FALSE); reintroduce; overload;
- destructor Destroy; override;
- function Save(filename: WideString; const clsidEncoder: TGUID; encoderParams: PEncoderParameters = nil): TStatus; overload;
- function GetFormat: TGPImageFormat;
- function GetWidth: UINT;
- function GetHeight: UINT;
- function GetHorizontalResolution: Single;
- function GetVerticalResolution: Single;
- function RotateFlip(rotateFlipType: TRotateFlipType): TStatus;
- end;
-
- TGPBitmap = class(TGPImage)
- public
- constructor Create(nativeBitmap: GpBitmap); reintroduce; overload;
- constructor Create(stream: IStream; useEmbeddedColorManagement: BOOL = FALSE); reintroduce; overload;
- constructor Create(width, height: Integer; format: TPixelFormat = PixelFormat32bppARGB); reintroduce; overload;
- function FromStream(stream: IStream; useEmbeddedColorManagement: BOOL = FALSE): TGPBitmap;
- function GetPixel(x, y: Integer; out color: TGPColor): TStatus;
- function SetPixel(x, y: Integer; color: TGPColor): TStatus;
- function SetResolution(xdpi, ydpi: Single): TStatus;
- end;
-
- TGPImageAttributes = class(TGdiplusBase)
- protected
- nativeImageAttr: GpImageAttributes;
- lastResult: TStatus;
- function SetStatus(status: TStatus): TStatus;
- public
- constructor Create; reintroduce; overload;
- destructor Destroy; override;
- function SetColorKey(colorLow, colorHigh: TGPColor; type_: TColorAdjustType = ColorAdjustTypeDefault): TStatus;
- function ClearColorKey(type_: TColorAdjustType = ColorAdjustTypeDefault): TStatus;
- end;
-
-(**************************************************************************\
-*
-* GDI+ Graphics Object
-*
-\**************************************************************************)
-
- TGPGraphics = class(TGdiplusBase)
- protected
- nativeGraphics: GpGraphics;
- lastResult: TStatus;
- procedure SetNativeGraphics(graphics: GpGraphics);
- function SetStatus(status: TStatus): TStatus;
- function GetNativeGraphics: GpGraphics;
- public
- //constructor Create(graphics: GpGraphics); reintroduce; overload;
- constructor Create(hdc: HDC); reintroduce; overload;
- constructor Create(image: TGPImage); reintroduce; overload;
- destructor Destroy; override;
- function FromImage(image: TGPImage): TGPGraphics;
- procedure Flush(intention: TFlushIntention = FlushIntentionFlush);
- //------------------------------------------------------------------------
- // GDI Interop methods
- //------------------------------------------------------------------------
- // Locks the graphics until ReleaseDC is called
- function GetHDC: HDC;
- procedure ReleaseHDC(hdc: HDC);
- //------------------------------------------------------------------------
- // Rendering modes
- //------------------------------------------------------------------------
- function SetCompositingQuality(compositingQuality: TCompositingQuality): TStatus;
- function GetCompositingQuality: TCompositingQuality;
-
- function SetTextRenderingHint(newMode: TTextRenderingHint): TStatus;
- function GetTextRenderingHint: TTextRenderingHint;
- function GetSmoothingMode: TSmoothingMode;
- function SetSmoothingMode(smoothingMode: TSmoothingMode): TStatus;
- // DrawPath
- function DrawPath(pen: TGPPen; path: TGPGraphicsPath): TStatus;
- // FillRectangle(s)
- function FillRectangle(brush: TGPBrush; const rect: TGPRectF): TStatus; overload;
- function FillRectangle(brush: TGPBrush; x, y, width, height: Single): TStatus; overload;
- // DrawString
- {$IFNDEF DELPHI_UNICODE}
- function DrawString(string_: string; length: Integer; font: TGPFont;
- const layoutRect: TGPRectF; stringFormat: TGPStringFormat; brush: TGPBrush): TStatus; overload;
- {$ENDIF}
- {$IFDEF DELPHI6_LVL}
- function DrawString(string_: widestring; length: Integer; font: TGPFont;
- const layoutRect: TGPRectF; stringFormat: TGPStringFormat; brush: TGPBrush): TStatus; overload;
- {$ENDIF}
- // MeasureString
- function MeasureString(string_: WideString; length: Integer; font: TGPFont;
- const layoutRect: TGPRectF; stringFormat: TGPStringFormat; out boundingBox: TGPRectF;
- codepointsFitted: PInteger = nil; linesFilled: PInteger = nil): TStatus; overload;
- function GetLastStatus: TStatus;
- // DrawRectangle
- function DrawRectangle(pen: TGPPen; const rect: TGPRectF): TStatus; overload;
- function DrawRectangle(pen: TGPPen; x, y, width, height: Single): TStatus; overload;
- // DrawImage
- function DrawImage(image: TGPImage; x, y: Integer): TStatus; overload;
- function DrawImageRect(image: TGPImage; x, y, w, h: Integer): TStatus; overload;
- function DrawImage(image: TGPImage; const destRect: TGPRectF; srcx, srcy,
- srcwidth, srcheight: Single; srcUnit: TUnit;
- imageAttributes: TGPImageAttributes = nil; callback: DrawImageAbort = nil;
- callbackData: Pointer = nil): TStatus; overload;
- // FillPath
- function FillPath(brush: TGPBrush; path: TGPGraphicsPath): TStatus;
- // Clip
- function ExcludeClip(const rect: TGPRectF): TStatus; overload;
- function ExcludeClip(region: TGPRegion): TStatus; overload;
- function SetClip(region: TGPRegion; combineMode: TCombineMode = CombineModeReplace): TStatus;
- function ResetClip: TStatus;
- end;
-
- function ColorToARGB(Color: TColor): ARGB;
-
- function GetEncoderQualityParameters(ImageQualityPercentage: integer): TEncoderParameters;
-
-
-////////////////////////////////////////////////////////////////////////////////
-
-var
- StartupInput: TGDIPlusStartupInput;
- StartupOutput: TGdiplusStartupOutput;
- gdiplusToken: ULONG;
-
-
-
-implementation
-
-function ColorToARGB(Color: TColor): ARGB;
-var
- c: TColor;
-begin
- c := ColorToRGB(Color);
- Result := ARGB( $FF000000 or ((DWORD(c) and $FF) shl 16) or ((DWORD(c) and $FF00) or ((DWORD(c) and $ff0000) shr 16)));
-end;
-
-
- function GdipAlloc; external WINGDIPDLL name 'GdipAlloc';
- procedure GdipFree; external WINGDIPDLL name 'GdipFree';
- function GdiplusStartup; external WINGDIPDLL name 'GdiplusStartup';
- procedure GdiplusShutdown; external WINGDIPDLL name 'GdiplusShutdown';
-
- function GdipCreatePath; external WINGDIPDLL name 'GdipCreatePath';
- function GdipDeletePath; external WINGDIPDLL name 'GdipDeletePath';
- //function GdipStartPathFigure; external WINGDIPDLL name 'GdipStartPathFigure';
- function GdipClosePathFigure; external WINGDIPDLL name 'GdipClosePathFigure';
- function GdipAddPathLine; external WINGDIPDLL name 'GdipAddPathLine';
- function GdipAddPathArc; external WINGDIPDLL name 'GdipAddPathArc';
- function GdipAddPathEllipse; external WINGDIPDLL name 'GdipAddPathEllipse';
- function GdipAddPathPie; external WINGDIPDLL name 'GdipAddPathPie';
- function GdipDeleteBrush; external WINGDIPDLL name 'GdipDeleteBrush';
- function GdipCreateSolidFill; external WINGDIPDLL name 'GdipCreateSolidFill';
- function GdipCreateLineBrushFromRect; external WINGDIPDLL name 'GdipCreateLineBrushFromRect';
- function GdipCreateLineBrushFromRectI; external WINGDIPDLL name 'GdipCreateLineBrushFromRectI';
- function GdipCreateLineBrushFromRectWithAngle; external WINGDIPDLL name 'GdipCreateLineBrushFromRectWithAngle';
- function GdipCreatePathGradient; external WINGDIPDLL name 'GdipCreatePathGradient';
- function GdipCreatePathGradientFromPath; external WINGDIPDLL name 'GdipCreatePathGradientFromPath';
- function GdipGetPathGradientCenterColor; external WINGDIPDLL name 'GdipGetPathGradientCenterColor';
- function GdipSetPathGradientCenterColor; external WINGDIPDLL name 'GdipSetPathGradientCenterColor';
- function GdipGetPathGradientSurroundColorsWithCount; external WINGDIPDLL name 'GdipGetPathGradientSurroundColorsWithCount';
- function GdipSetPathGradientSurroundColorsWithCount; external WINGDIPDLL name 'GdipSetPathGradientSurroundColorsWithCount';
- function GdipGetPathGradientCenterPoint; external WINGDIPDLL name 'GdipGetPathGradientCenterPoint';
- function GdipGetPathGradientCenterPointI; external WINGDIPDLL name 'GdipGetPathGradientCenterPointI';
- function GdipSetPathGradientCenterPoint; external WINGDIPDLL name 'GdipSetPathGradientCenterPoint';
- function GdipSetPathGradientCenterPointI; external WINGDIPDLL name 'GdipSetPathGradientCenterPointI';
- function GdipGetPathGradientPointCount; external WINGDIPDLL name 'GdipGetPathGradientPointCount';
- function GdipGetPathGradientSurroundColorCount; external WINGDIPDLL name 'GdipGetPathGradientSurroundColorCount';
- function GdipCreatePen1; external WINGDIPDLL name 'GdipCreatePen1';
- function GdipDeletePen; external WINGDIPDLL name 'GdipDeletePen';
- function GdipFlush; external WINGDIPDLL name 'GdipFlush';
- function GdipCreateFromHDC; external WINGDIPDLL name 'GdipCreateFromHDC';
- function GdipGetImageGraphicsContext; external WINGDIPDLL name 'GdipGetImageGraphicsContext';
- function GdipDeleteGraphics; external WINGDIPDLL name 'GdipDeleteGraphics';
- function GdipGetDC; external WINGDIPDLL name 'GdipGetDC';
- function GdipReleaseDC; external WINGDIPDLL name 'GdipReleaseDC';
- function GdipSetSmoothingMode; external WINGDIPDLL name 'GdipSetSmoothingMode';
- function GdipGetSmoothingMode; external WINGDIPDLL name 'GdipGetSmoothingMode';
- function GdipSetTextRenderingHint; external WINGDIPDLL name 'GdipSetTextRenderingHint';
- function GdipGetTextRenderingHint; external WINGDIPDLL name 'GdipGetTextRenderingHint';
- function GdipDrawPath; external WINGDIPDLL name 'GdipDrawPath';
- function GdipFillRectangle; external WINGDIPDLL name 'GdipFillRectangle';
- function GdipCreateFontFamilyFromName; external WINGDIPDLL name 'GdipCreateFontFamilyFromName';
- function GdipDeleteFontFamily; external WINGDIPDLL name 'GdipDeleteFontFamily';
- function GdipCreateFont; external WINGDIPDLL name 'GdipCreateFont';
- function GdipDeleteFont; external WINGDIPDLL name 'GdipDeleteFont';
- function GdipDrawString; external WINGDIPDLL name 'GdipDrawString';
- function GdipMeasureString; external WINGDIPDLL name 'GdipMeasureString';
- function GdipCreateStringFormat; external WINGDIPDLL name 'GdipCreateStringFormat';
- function GdipDeleteStringFormat; external WINGDIPDLL name 'GdipDeleteStringFormat';
- function GdipCloneStringFormat; external WINGDIPDLL name 'GdipCloneStringFormat';
- function GdipSetStringFormatAlign; external WINGDIPDLL name 'GdipSetStringFormatAlign';
- function GdipGetStringFormatAlign; external WINGDIPDLL name 'GdipGetStringFormatAlign';
- function GdipSetStringFormatLineAlign; external WINGDIPDLL name 'GdipSetStringFormatLineAlign';
- function GdipGetStringFormatLineAlign; external WINGDIPDLL name 'GdipGetStringFormatLineAlign';
- function GdipSetStringFormatTrimming; external WINGDIPDLL name 'GdipSetStringFormatTrimming';
- function GdipGetStringFormatTrimming; external WINGDIPDLL name 'GdipGetStringFormatTrimming';
- function GdipGetImageRawFormat; external WINGDIPDLL name 'GdipGetImageRawFormat';
- function GdipDrawImage; external WINGDIPDLL name 'GdipDrawImage';
- function GdipDrawImageI; external WINGDIPDLL name 'GdipDrawImageI';
- function GdipDrawImageRect; external WINGDIPDLL name 'GdipDrawImageRect';
- function GdipDrawImageRectI; external WINGDIPDLL name 'GdipDrawImageRectI';
- function GdipDrawRectangle; external WINGDIPDLL name 'GdipDrawRectangle';
- function GdipDrawRectangleI; external WINGDIPDLL name 'GdipDrawRectangleI';
- function GdipFillPath; external WINGDIPDLL name 'GdipFillPath';
- function GdipGetImageDecodersSize; external WINGDIPDLL name 'GdipGetImageDecodersSize';
- function GdipGetImageDecoders; external WINGDIPDLL name 'GdipGetImageDecoders';
- function GdipGetImageEncodersSize; external WINGDIPDLL name 'GdipGetImageEncodersSize';
- function GdipGetImageEncoders; external WINGDIPDLL name 'GdipGetImageEncoders';
- function GdipSaveImageToFile; external WINGDIPDLL name 'GdipSaveImageToFile';
- function GdipLoadImageFromFileICM; external WINGDIPDLL name 'GdipLoadImageFromFileICM';
- function GdipLoadImageFromFile; external WINGDIPDLL name 'GdipLoadImageFromFile';
- function GdipLoadImageFromStream; external WINGDIPDLL name 'GdipLoadImageFromStream';
- function GdipLoadImageFromStreamICM; external WINGDIPDLL name 'GdipLoadImageFromStreamICM';
- function GdipDisposeImage; external WINGDIPDLL name 'GdipDisposeImage';
- function GdipGetImageWidth; external WINGDIPDLL name 'GdipGetImageWidth';
- function GdipGetImageHeight; external WINGDIPDLL name 'GdipGetImageHeight';
- function GdipGetImageHorizontalResolution; external WINGDIPDLL name 'GdipGetImageHorizontalResolution';
- function GdipGetImageVerticalResolution; external WINGDIPDLL name 'GdipGetImageVerticalResolution';
- function GdipGetPenDashStyle; external WINGDIPDLL name 'GdipGetPenDashStyle';
- function GdipSetPenDashStyle; external WINGDIPDLL name 'GdipSetPenDashStyle';
- function GdipSetStringFormatHotkeyPrefix; external WINGDIPDLL name 'GdipSetStringFormatHotkeyPrefix';
- function GdipGetStringFormatHotkeyPrefix; external WINGDIPDLL name 'GdipGetStringFormatHotkeyPrefix';
- function GdipSetClipRect; external WINGDIPDLL name 'GdipSetClipRect';
- function GdipSetClipRegion; external WINGDIPDLL name 'GdipSetClipRegion';
- function GdipCreateRegionRect; external WINGDIPDLL name 'GdipCreateRegionRect';
- function GdipCreateRegionPath; external WINGDIPDLL name 'GdipCreateRegionPath';
- function GdipDeleteRegion; external WINGDIPDLL name 'GdipDeleteRegion';
- function GdipCombineRegionPath; external WINGDIPDLL name 'GdipCombineRegionPath';
- function GdipCombineRegionRegion; external WINGDIPDLL name 'GdipCombineRegionRegion';
- function GdipSetCompositingQuality; external WINGDIPDLL name 'GdipSetCompositingQuality';
- function GdipGetCompositingQuality; external WINGDIPDLL name 'GdipGetCompositingQuality';
- function GdipImageRotateFlip; external WINGDIPDLL name 'GdipImageRotateFlip';
- function GdipCreateBitmapFromStreamICM; external WINGDIPDLL name 'GdipCreateBitmapFromStreamICM';
- function GdipCreateBitmapFromStream; external WINGDIPDLL name 'GdipCreateBitmapFromStream';
- function GdipCreateBitmapFromScan0; external WINGDIPDLL name 'GdipCreateBitmapFromScan0';
- function GdipBitmapGetPixel; external WINGDIPDLL name 'GdipBitmapGetPixel';
- function GdipBitmapSetPixel; external WINGDIPDLL name 'GdipBitmapSetPixel';
- function GdipBitmapSetResolution; external WINGDIPDLL name 'GdipBitmapSetResolution';
-
- function GdipSetPenEndCap; external WINGDIPDLL name 'GdipSetPenEndCap';
- function GdipAddPathLine2I; external WINGDIPDLL name 'GdipAddPathLine2I';
- function GdipCreateImageAttributes; external WINGDIPDLL name 'GdipCreateImageAttributes';
- function GdipDisposeImageAttributes; external WINGDIPDLL name 'GdipDisposeImageAttributes';
- function GdipSetImageAttributesColorKeys; external WINGDIPDLL name 'GdipSetImageAttributesColorKeys';
- function GdipDrawImageRectRect; external WINGDIPDLL name 'GdipDrawImageRectRect';
-
- function GdipAddPathPolygon; external WINGDIPDLL name 'GdipAddPathPolygon';
- function GdipAddPathPolygonI; external WINGDIPDLL name 'GdipAddPathPolygonI';
- function GdipAddPathCurveI; external WINGDIPDLL name 'GdipAddPathCurveI';
- function GdipAddPathCurve; external WINGDIPDLL name 'GdipAddPathCurve';
- function GdipAddPathCurve2I; external WINGDIPDLL name 'GdipAddPathCurve2I';
- function GdipResetClip; external WINGDIPDLL name 'GdipResetClip';
- function GdipAddPathBezier; external WINGDIPDLL name 'GdipAddPathBezier';
-// -----------------------------------------------------------------------------
-// TGdiplusBase class
-// -----------------------------------------------------------------------------
-
-
-class function TGdiplusBase.NewInstance: TObject;
-var
- p : pointer;
- sz : ULONG;
-begin
- { Note: GidpAlloc may fail on Windows XP if application is started from
- Delphi 2007 in debug mode.
- The reason for this fix is to workaround the following problem:
- After an application with a TAdvOfficeToolBar executes a standard TOpenDialog,
- an exception is raised while drawing the officetoolbar. }
- sz := ULONG(InstanceSize);
- p := GdipAlloc(sz);
- if not Assigned(p) then
- begin
- //GdipAlloc failed --> restart GDI+ and try again
- GdiplusStartup(gdiplusToken, @StartupInput, @StartupOutput);
- p := GdipAlloc(sz);
- end;
- Result := InitInstance(p);
-end;
-
-procedure TGdiplusBase.FreeInstance;
-begin
- CleanupInstance;
- GdipFree(Self);
-end;
-
-
-function GetImageEncoders(numEncoders, size: UINT;
- encoders: PImageCodecInfo): TStatus;
-begin
- result := GdipGetImageEncoders(numEncoders, size, encoders);
-end;
-
-function GetImageEncodersSize(out numEncoders, size: UINT): TStatus;
-begin
- result := GdipGetImageEncodersSize(numEncoders, size);
-end;
-
-function GetEncoderClsid(format: String; out pClsid: TGUID): integer;
-var
- num, size, j: UINT;
- ImageCodecInfo: PImageCodecInfo;
-Type
- ArrIMgInf = array of TImageCodecInfo;
-begin
- num := 0; // number of image encoders
- size := 0; // size of the image encoder array in bytes
- result := -1;
-
- GetImageEncodersSize(num, size);
- if (size = 0) then exit;
-
- GetMem(ImageCodecInfo, size);
- if(ImageCodecInfo = nil) then exit;
-
- GetImageEncoders(num, size, ImageCodecInfo);
-
- for j := 0 to num - 1 do
- begin
- if( ArrIMgInf(ImageCodecInfo)[j].MimeType = format) then
- begin
- pClsid := ArrIMgInf(ImageCodecInfo)[j].Clsid;
- result := j; // Success
- end;
- end;
- FreeMem(ImageCodecInfo, size);
-end;
-
-
-
-function GetEncoderQualityParameters(ImageQualityPercentage: integer): TEncoderParameters;
-var
- encoderParameters: TEncoderParameters;
- value: integer;
-begin
- if ImageQualityPercentage < 0 then
- ImageQualityPercentage := 0;
-
- if ImageQualityPercentage > 100 then
- ImageQualityPercentage := 100;
-
- value := ImageQualityPercentage;
- encoderParameters.Count := 1;
- encoderParameters.Parameter[0].Guid := EncoderQuality;
- encoderParameters.Parameter[0].Type_ := EncoderParameterValueTypeLong;
- encoderParameters.Parameter[0].Value := @value;
- encoderParameters.Parameter[0].NumberOfValues := 1;
-
- result := encoderParameters;
-end;
-
-
-//--------------------------------------------------------------------------
-// TGPPoint Util
-//--------------------------------------------------------------------------
-
-function MakePoint(X, Y: Integer): TGPPoint;
-begin
- result.X := X;
- result.Y := Y;
-end;
-
-function MakePoint(X, Y: Single): TGPPointF;
-begin
- Result.X := X;
- result.Y := Y;
-end;
-
-// -----------------------------------------------------------------------------
-// RectF class
-// -----------------------------------------------------------------------------
-
-function MakeRect(x, y, width, height: Single): TGPRectF; overload;
-begin
- Result.X := x;
- Result.Y := y;
- Result.Width := width;
- Result.Height := height;
-end;
-
-
-//******************************************************************************
-(**************************************************************************\
-*
-* GDI+ StringFormat class
-*
-\**************************************************************************)
-
-constructor TGPStringFormat.Create(formatFlags: Integer = 0; language: LANGID = LANG_NEUTRAL);
-begin
- nativeFormat := nil;
- lastError := GdipCreateStringFormat(formatFlags, language, nativeFormat);
-end;
-
-destructor TGPStringFormat.Destroy;
-begin
- GdipDeleteStringFormat(nativeFormat);
-end;
-
-function TGPStringFormat.SetAlignment(align: TStringAlignment): TStatus;
-begin
- result := SetStatus(GdipSetStringFormatAlign(nativeFormat, align));
-end;
-
-function TGPStringFormat.GetAlignment: TStringAlignment;
-begin
- SetStatus(GdipGetStringFormatAlign(nativeFormat, result));
-end;
-
-function TGPStringFormat.SetLineAlignment(align: TStringAlignment): TStatus;
-begin
- result := SetStatus(GdipSetStringFormatLineAlign(nativeFormat, align));
-end;
-
-function TGPStringFormat.GetLineAlignment: TStringAlignment;
-begin
- SetStatus(GdipGetStringFormatLineAlign(nativeFormat, result));
-end;
-
-
-function TGPStringFormat.SetTrimming(trimming: TStringTrimming): TStatus;
-begin
- result := SetStatus(GdipSetStringFormatTrimming(nativeFormat, trimming));
-end;
-
-function TGPStringFormat.GetTrimming: TStringTrimming;
-begin
- SetStatus(GdipGetStringFormatTrimming(nativeFormat, result));
-end;
-
-function TGPStringFormat.SetHotkeyPrefix(hotkeyPrefix: THotkeyPrefix): TStatus;
-begin
- result := SetStatus(GdipSetStringFormatHotkeyPrefix(nativeFormat, Integer(hotkeyPrefix)));
-end;
-
-function TGPStringFormat.GetHotkeyPrefix: THotkeyPrefix;
-var HotkeyPrefix: Integer;
-begin
- SetStatus(GdipGetStringFormatHotkeyPrefix(nativeFormat, HotkeyPrefix));
- result := THotkeyPrefix(HotkeyPrefix);
-end;
-
-
-function TGPStringFormat.SetStatus(newStatus: GpStatus): TStatus;
-begin
- if (newStatus <> Ok) then lastError := newStatus;
- result := newStatus;
-end;
-
-// operator =
-procedure TGPStringFormat.Assign(source: TGPStringFormat);
-begin
- assert(assigned(source));
- GdipDeleteStringFormat(nativeFormat);
- lastError := GdipCloneStringFormat(source.nativeFormat, nativeFormat);
-end;
-
-constructor TGPStringFormat.Create(clonedStringFormat: GpStringFormat; status: TStatus);
-begin
- lastError := status;
- nativeFormat := clonedStringFormat;
-end;
-
-(**************************************************************************\
-*
-* GDI+ Pen class
-*
-\**************************************************************************)
-
-//--------------------------------------------------------------------------
-// Pen class
-//--------------------------------------------------------------------------
-
-constructor TGPPen.Create(color: TGPColor; width: Single = 1.0);
-var unit_: TUnit;
-begin
- unit_ := UnitWorld;
- nativePen := nil;
- lastResult := GdipCreatePen1(color, width, unit_, nativePen);
-end;
-
-destructor TGPPen.Destroy;
-begin
- GdipDeletePen(nativePen);
-end;
-
-constructor TGPPen.Create(nativePen: GpPen; status: TStatus);
-begin
- lastResult := status;
- SetNativePen(nativePen);
-end;
-
-procedure TGPPen.SetNativePen(nativePen: GpPen);
-begin
- self.nativePen := nativePen;
-end;
-
-function TGPPen.SetStatus(status: TStatus): TStatus;
-begin
- if (status <> Ok) then lastResult := status;
- result := status;
-end;
-
-function TGPPen.GetDashStyle: TDashStyle;
-begin
- SetStatus(GdipGetPenDashStyle(nativePen, result));
-end;
-
-function TGPPen.SetDashStyle(dashStyle: TDashStyle): TStatus;
-begin
- result := SetStatus(GdipSetPenDashStyle(nativePen, dashStyle));
-end;
-
-function TGPPen.SetEndCap(endCap: TLineCap): TStatus;
-begin
- result := SetStatus(GdipSetPenEndCap(nativePen, endCap));
-end;
-
-
-(**************************************************************************\
-*
-* GDI+ Brush class
-*
-\**************************************************************************)
-
-//--------------------------------------------------------------------------
-// Abstract base class for various brush types
-//--------------------------------------------------------------------------
-
-destructor TGPBrush.Destroy;
-begin
- GdipDeleteBrush(nativeBrush);
-end;
-
-constructor TGPBrush.Create;
-begin
- SetStatus(NotImplemented);
-end;
-
-constructor TGPBrush.Create(nativeBrush: GpBrush; status: TStatus);
-begin
- lastResult := status;
- SetNativeBrush(nativeBrush);
-end;
-
-procedure TGPBrush.SetNativeBrush(nativeBrush: GpBrush);
-begin
- self.nativeBrush := nativeBrush;
-end;
-
-function TGPBrush.SetStatus(status: TStatus): TStatus;
-begin
- if (status <> Ok) then lastResult := status;
- result := status;
-end;
-
-//--------------------------------------------------------------------------
-// Solid Fill Brush Object
-//--------------------------------------------------------------------------
-
-constructor TGPSolidBrush.Create(color: TGPColor);
-var
- brush: GpSolidFill;
-begin
- brush := nil;
- lastResult := GdipCreateSolidFill(color, brush);
- SetNativeBrush(brush);
-end;
-
-constructor TGPSolidBrush.Create;
-begin
- // hide parent function
-end;
-
-//--------------------------------------------------------------------------
-// Linear Gradient Brush Object
-//--------------------------------------------------------------------------
-
-constructor TGPLinearGradientBrush.Create(rect: TGPRectF; color1, color2: TGPColor; mode: TLinearGradientMode);
-var brush: GpLineGradient;
-begin
- brush := nil;
- lastResult := GdipCreateLineBrushFromRect(@rect, color1,
- color2, mode, WrapModeTile, brush);
- SetNativeBrush(brush);
-end;
-
-constructor TGPLinearGradientBrush.Create(rect: TGPRect; color1, color2: TGPColor; mode: TLinearGradientMode);
-var brush: GpLineGradient;
-begin
- brush := nil;
- lastResult := GdipCreateLineBrushFromRectI(@rect, color1,
- color2, mode, WrapModeTile, brush);
- SetNativeBrush(brush);
-end;
-
-constructor TGPLinearGradientBrush.Create;
-begin
- // hide parent function
-end;
-
-(**************************************************************************\
-*
-* GDI+ Graphics Object
-*
-\**************************************************************************)
-
-constructor TGPGraphics.Create(hdc: HDC);
-var
- graphics: GpGraphics;
-begin
- graphics:= nil;
- lastResult := GdipCreateFromHDC(hdc, graphics);
- SetNativeGraphics(graphics);
-end;
-
-destructor TGPGraphics.Destroy;
-begin
- GdipDeleteGraphics(nativeGraphics);
-end;
-
-procedure TGPGraphics.Flush(intention: TFlushIntention = FlushIntentionFlush);
-begin
- GdipFlush(nativeGraphics, intention);
-end;
-
-function TGPGraphics.FromImage(image: TGPImage): TGPGraphics;
-begin
- Result := TGPGraphics.Create(image);
-end;
-
-constructor TGPGraphics.Create(image: TGPImage);
-var
- graphics: GpGraphics;
-begin
- graphics:= nil;
- if (image <> nil) then
- lastResult := GdipGetImageGraphicsContext(image.nativeImage, graphics);
- SetNativeGraphics(graphics);
-end;
-
-
-//------------------------------------------------------------------------
-// GDI Interop methods
-//------------------------------------------------------------------------
-
-// Locks the graphics until ReleaseDC is called
-
-function TGPGraphics.GetHDC: HDC;
-begin
- SetStatus(GdipGetDC(nativeGraphics, result));
-end;
-
-procedure TGPGraphics.ReleaseHDC(hdc: HDC);
-begin
- SetStatus(GdipReleaseDC(nativeGraphics, hdc));
-end;
-
-function TGPGraphics.SetTextRenderingHint(newMode: TTextRenderingHint): TStatus;
-begin
- result := SetStatus(GdipSetTextRenderingHint(nativeGraphics, newMode));
-end;
-
-function TGPGraphics.GetTextRenderingHint: TTextRenderingHint;
-begin
- SetStatus(GdipGetTextRenderingHint(nativeGraphics, result));
-end;
-
-function TGPGraphics.GetSmoothingMode: TSmoothingMode;
-var
- smoothingMode: TSmoothingMode;
-begin
- smoothingMode := SmoothingModeInvalid;
- SetStatus(GdipGetSmoothingMode(nativeGraphics, smoothingMode));
- result := smoothingMode;
-end;
-
-function TGPGraphics.SetSmoothingMode(smoothingMode: TSmoothingMode): TStatus;
-begin
- result := SetStatus(GdipSetSmoothingMode(nativeGraphics, smoothingMode));
-end;
-
-function TGPGraphics.DrawPath(pen: TGPPen; path: TGPGraphicsPath): TStatus;
-var
- nPen: GpPen;
- nPath: GpPath;
-begin
- if Assigned(pen) then
- nPen := pen.nativePen
- else
- nPen := nil;
- if Assigned(path) then
- nPath := path.nativePath
- else
- nPath := nil;
- Result := SetStatus(GdipDrawPath(nativeGraphics, nPen, nPath));
-end;
-
-function TGPGraphics.FillRectangle(brush: TGPBrush; const rect: TGPRectF): TStatus;
-begin
- Result := FillRectangle(brush, rect.X, rect.Y, rect.Width, rect.Height);
-end;
-
-function TGPGraphics.FillRectangle(brush: TGPBrush; x, y, width, height: Single): TStatus;
-begin
- result := SetStatus(GdipFillRectangle(nativeGraphics, brush.nativeBrush, x, y,
- width, height));
-end;
-
-{$IFNDEF DELPHI_UNICODE}
-function TGPGraphics.DrawString( string_: string; length: Integer; font: TGPFont;
- const layoutRect: TGPRectF; stringFormat: TGPStringFormat; brush: TGPBrush): TStatus;
-var
- nFont: GpFont;
- nStringFormat: GpStringFormat;
- nBrush: GpBrush;
- wCh: PWidechar;
- i: integer;
-begin
- if Assigned(font) then
- nfont := font.nativeFont
- else
- nfont := nil;
- if Assigned(stringFormat) then
- nstringFormat := stringFormat.nativeFormat
- else
- nstringFormat := nil;
-
- {charset issue}
- i := System.Length(string_);
- GetMem(wCh, i * 2 + 2);
- FillChar(wCh^, i * 2 + 2,0);
- StringToWidechar(string_, wCh, i * 2 + 2);
- {/charset issue}
-
- if Assigned(brush) then
- nbrush := brush.nativeBrush
- else
- nbrush := nil;
-// Result := SetStatus(GdipDrawString(nativeGraphics, PWideChar(string_),
-// length, nfont, @layoutRect, nstringFormat, nbrush));
-
- {charset issue}
- Result := SetStatus(GdipDrawString(nativeGraphics, wCh,
- length, nfont, @layoutRect, nstringFormat, nbrush));
-
- FreeMem(wCh);
- {/charset issue}
-end;
-{$ENDIF}
-
-{$IFDEF DELPHI6_LVL}
-function TGPGraphics.DrawString( string_: widestring; length: Integer; font: TGPFont;
- const layoutRect: TGPRectF; stringFormat: TGPStringFormat; brush: TGPBrush): TStatus;
-var
- nFont: GpFont;
- nStringFormat: GpStringFormat;
- nBrush: GpBrush;
-begin
- if Assigned(font) then
- nfont := font.nativeFont
- else
- nfont := nil;
- if Assigned(stringFormat) then
- nstringFormat := stringFormat.nativeFormat
- else
- nstringFormat := nil;
-
- if Assigned(brush) then
- nbrush := brush.nativeBrush
- else
- nbrush := nil;
-
- Result := SetStatus(GdipDrawString(nativeGraphics, PWideChar(string_),
- length, nfont, @layoutRect, nstringFormat, nbrush));
-end;
-{$ENDIF}
-
-function TGPGraphics.MeasureString(string_: WideString; length: Integer; font: TGPFont;
- const layoutRect: TGPRectF; stringFormat: TGPStringFormat; out boundingBox: TGPRectF;
- codepointsFitted: PInteger = nil; linesFilled: PInteger = nil): TStatus;
-var
- nFont: GpFont;
- nStringFormat: GpStringFormat;
-begin
- if Assigned(font) then
- nfont := font.nativeFont
- else
- nfont := nil;
- if Assigned(stringFormat) then
- nstringFormat := stringFormat.nativeFormat
- else
- nstringFormat := nil;
-
- Result := SetStatus(GdipMeasureString(nativeGraphics, PWideChar(string_),
- length, nfont, @layoutRect, nstringFormat, @boundingBox, codepointsFitted,
- linesFilled));
-end;
-
-function TGPGraphics.GetLastStatus: TStatus;
-begin
- result := lastResult;
- lastResult := Ok;
-end;
-
-{
-constructor TGPGraphics.Create(graphics: GpGraphics);
-begin
- lastResult := Ok;
- SetNativeGraphics(graphics);
-end;
-}
-
-procedure TGPGraphics.SetNativeGraphics(graphics: GpGraphics);
-begin
- self.nativeGraphics := graphics;
-end;
-
-function TGPGraphics.SetStatus(status: TStatus): TStatus;
-begin
- if (status <> Ok) then
- lastResult := status;
- result := status;
-end;
-
-function TGPGraphics.GetNativeGraphics: GpGraphics;
-begin
- result := self.nativeGraphics;
-end;
-
-//------------------------------------------------------------------------------
-
- constructor TGPRegion.Create(rect: TGPRectF);
- var
- region: GpRegion;
- begin
- region := nil;
- lastResult := GdipCreateRegionRect(@rect, region);
- SetNativeRegion(region);
- end;
-
- constructor TGPRegion.Create(path: TGPGraphicsPath);
- var
- region: GpRegion;
- begin
- region := nil;
- lastResult := GdipCreateRegionPath(path.nativePath, region);
- SetNativeRegion(region);
- end;
-
- destructor TGPRegion.Destroy;
- begin
- GdipDeleteRegion(nativeRegion);
- end;
-
- function TGPRegion.Exclude(path: TGPGraphicsPath): TStatus;
- begin
- result := SetStatus(GdipCombineRegionPath(nativeRegion, path.nativePath, CombineModeExclude));
- end;
-
- function TGPRegion.SetStatus(status: TStatus): TStatus;
- begin
- if (status <> Ok) then lastResult := status;
- result := status;
- end;
-
- procedure TGPRegion.SetNativeRegion(nativeRegion: GpRegion);
- begin
- self.nativeRegion := nativeRegion;
- end;
-
- function TGPRegion.Union(region: TGPRegion): TStatus;
- begin
- result := SetStatus(GdipCombineRegionRegion(nativeRegion, region.nativeRegion,
- CombineModeUnion));
- end;
-
-(**************************************************************************\
-*
-* GDI+ Font Family class
-*
-\**************************************************************************)
-
- constructor TGPFontFamily.Create(name: WideString; fontCollection: TGPFontCollection = nil);
- var nfontCollection: GpfontCollection;
- begin
- nativeFamily := nil;
- if assigned(fontCollection) then nfontCollection := fontCollection.nativeFontCollection else nfontCollection := nil;
- lastResult := GdipCreateFontFamilyFromName(PWideChar(name), nfontCollection, nativeFamily);
- end;
-
- destructor TGPFontFamily.Destroy;
- begin
- GdipDeleteFontFamily (nativeFamily);
- end;
-
- function TGPFontFamily.SetStatus(status: TStatus): TStatus;
- begin
- if (status <> Ok) then lastResult := status;
- result := status;
- end;
-
- constructor TGPFontFamily.Create(nativeOrig: GpFontFamily; status: TStatus);
- begin
- lastResult := status;
- nativeFamily := nativeOrig;
- end;
-
-(**************************************************************************\
-*
-* GDI+ Font class
-*
-\**************************************************************************)
-
- constructor TGPFont.Create(family: TGPFontFamily; emSize: Single;
- style: TFontStyle = FontStyleRegular; unit_: TUnit = UnitPoint);
- var
- font: GpFont;
- nFontFamily: GpFontFamily;
- begin
- font := nil;
- if Assigned(Family) then
- nFontFamily := Family.nativeFamily
- else
- nFontFamily := nil;
-
- lastResult := GdipCreateFont(nFontFamily, emSize, Integer(style), Integer(unit_), font);
-
- SetNativeFont(font);
- end;
-
- destructor TGPFont.Destroy;
- begin
- GdipDeleteFont(nativeFont);
- end;
-
- constructor TGPFont.Create(font: GpFont; status: TStatus);
- begin
- lastResult := status;
- SetNativeFont(font);
- end;
-
- procedure TGPFont.SetNativeFont(Font: GpFont);
- begin
- nativeFont := Font;
- end;
-
- function TGPFont.SetStatus(status: TStatus): TStatus;
- begin
- if (status <> Ok) then lastResult := status;
- result := status;
- end;
-
-(**************************************************************************\
-*
-* Font collections (Installed and Private)
-*
-\**************************************************************************)
-
- constructor TGPFontCollection.Create;
- begin
- nativeFontCollection := nil;
- end;
-
- destructor TGPFontCollection.Destroy;
- begin
- inherited Destroy;
- end;
-
- function TGPFontCollection.SetStatus(status: TStatus): TStatus;
- begin
- lastResult := status;
- result := lastResult;
- end;
-
-(**************************************************************************\
-*
-* GDI+ Graphics Path class
-*
-\**************************************************************************)
-
- constructor TGPGraphicsPath.Create(fillMode: TFillMode = FillModeAlternate);
- begin
- nativePath := nil;
- lastResult := GdipCreatePath(fillMode, nativePath);
- end;
-
- destructor TGPGraphicsPath.Destroy;
- begin
- GdipDeletePath(nativePath);
- end;
-
- function TGPGraphicsPath.CloseFigure: TStatus;
- begin
- result := SetStatus(GdipClosePathFigure(nativePath));
- end;
-
- function TGPGraphicsPath.AddLine(const pt1, pt2: TGPPointF): TStatus;
- begin
- result := AddLine(pt1.X, pt1.Y, pt2.X, pt2.Y);
- end;
-
- function TGPGraphicsPath.AddLine(x1, y1, x2, y2: Single): TStatus;
- begin
- result := SetStatus(GdipAddPathLine(nativePath, x1, y1,
- x2, y2));
- end;
-
- function TGPGraphicsPath.AddArc(rect: TGPRectF; startAngle, sweepAngle: Single): TStatus;
- begin
- result := AddArc(rect.X, rect.Y, rect.Width, rect.Height,
- startAngle, sweepAngle);
- end;
-
- function TGPGraphicsPath.AddArc(x, y, width, height, startAngle, sweepAngle: Single): TStatus;
- begin
- result := SetStatus(GdipAddPathArc(nativePath, x, y, width, height, startAngle, sweepAngle));
- end;
-
- function TGPGraphicsPath.AddEllipse(rect: TGPRectF): TStatus;
- begin
- result := AddEllipse(rect.X, rect.Y, rect.Width, rect.Height);
- end;
-
- function TGPGraphicsPath.AddEllipse(x, y, width, height: Single): TStatus;
- begin
- result := SetStatus(GdipAddPathEllipse(nativePath,
- x,
- y,
- width,
- height));
- end;
-
- {
- constructor TGPGraphicsPath.Create(path: TGPGraphicsPath);
- var clonepath: GpPath;
- begin
- clonepath := nil;
- SetStatus(GdipClonePath(path.nativePath, clonepath));
- SetNativePath(clonepath);
- end;
- }
- constructor TGPGraphicsPath.Create(nativePath: GpPath);
- begin
- lastResult := Ok;
- SetNativePath(nativePath);
- end;
-
- procedure TGPGraphicsPath.SetNativePath(nativePath: GpPath);
- begin
- self.nativePath := nativePath;
- end;
-
- function TGPGraphicsPath.SetStatus(status: TStatus): TStatus;
- begin
- if (status <> Ok) then LastResult := status;
- result := status;
- end;
-
-//--------------------------------------------------------------------------
-// Path Gradient Brush
-//--------------------------------------------------------------------------
- {
- constructor TGPPathGradientBrush.Create(points: PGPPointF; count: Integer; wrapMode: TWrapMode = WrapModeClamp);
- var brush: GpPathGradient;
- begin
- brush := nil;
- lastResult := GdipCreatePathGradient(points, count, wrapMode, brush);
- SetNativeBrush(brush);
- end;
- }
- constructor TGPPathGradientBrush.Create(path: TGPGraphicsPath);
- var brush: GpPathGradient;
- begin
- brush := nil;
- lastResult := GdipCreatePathGradientFromPath(path.nativePath, brush);
- SetNativeBrush(brush);
- end;
-
- function TGPPathGradientBrush.GetCenterColor(out Color: TGPColor): TStatus;
- begin
- SetStatus(GdipGetPathGradientCenterColor(GpPathGradient(nativeBrush), Color));
- result := lastResult;
- end;
-
- function TGPPathGradientBrush.SetCenterColor(color: TGPColor): TStatus;
- begin
- SetStatus(GdipSetPathGradientCenterColor(GpPathGradient(nativeBrush),color));
- result := lastResult;
- end;
-
- function TGPPathGradientBrush.GetPointCount: Integer;
- begin
- SetStatus(GdipGetPathGradientPointCount(GpPathGradient(nativeBrush), result));
- end;
-
- function TGPPathGradientBrush.GetSurroundColors(colors: PARGB; var count: Integer): TStatus;
- var
- count1: Integer;
- begin
- if not assigned(colors) then
- begin
- result := SetStatus(InvalidParameter);
- exit;
- end;
-
- SetStatus(GdipGetPathGradientSurroundColorCount(GpPathGradient(nativeBrush), count1));
-
- if(lastResult <> Ok) then
- begin
- result := lastResult;
- exit;
- end;
-
- if((count < count1) or (count1 <= 0)) then
- begin
- result := SetStatus(InsufficientBuffer);
- exit;
- end;
-
- SetStatus(GdipGetPathGradientSurroundColorsWithCount(GpPathGradient(nativeBrush), colors, count1));
- if(lastResult = Ok) then
- count := count1;
-
- result := lastResult;
- end;
-
- function TGPPathGradientBrush.SetSurroundColors(colors: PARGB; var count: Integer): TStatus;
- var
- count1: Integer;
- type
- TDynArrDWORD = array of DWORD;
- begin
- if (colors = nil) then
- begin
- result := SetStatus(InvalidParameter);
- exit;
- end;
-
- count1 := GetPointCount;
-
- if((count > count1) or (count1 <= 0)) then
- begin
- result := SetStatus(InvalidParameter);
- exit;
- end;
-
- count1 := count;
-
- SetStatus(GdipSetPathGradientSurroundColorsWithCount(
- GpPathGradient(nativeBrush), colors, count1));
-
- if(lastResult = Ok) then count := count1;
- result := lastResult;
- end;
-
- function TGPPathGradientBrush.GetCenterPoint(out point: TGPPointF): TStatus;
- begin
- result := SetStatus(GdipGetPathGradientCenterPoint(GpPathGradient(nativeBrush), @point));
- end;
-
- function TGPPathGradientBrush.GetCenterPoint(out point: TGPPoint): TStatus;
- begin
- result := SetStatus(GdipGetPathGradientCenterPointI(GpPathGradient(nativeBrush), @point));
- end;
-
- function TGPPathGradientBrush.SetCenterPoint(point: TGPPointF): TStatus;
- begin
- result := SetStatus(GdipSetPathGradientCenterPoint(GpPathGradient(nativeBrush), @point));
- end;
-
- function TGPPathGradientBrush.SetCenterPoint(point: TGPPoint): TStatus;
- begin
- result := SetStatus(GdipSetPathGradientCenterPointI(GpPathGradient(nativeBrush), @point));
- end;
-
-function TGPGraphics.DrawRectangle(pen: TGPPen; const rect: TGPRectF): TStatus;
-begin
- Result := DrawRectangle(pen, rect.X, rect.Y, rect.Width, rect.Height);
-end;
-
-function TGPGraphics.DrawRectangle(pen: TGPPen; x, y, width, height: Single): TStatus;
-begin
- Result := SetStatus(GdipDrawRectangle(nativeGraphics, pen.nativePen, x, y, width, height));
-end;
-
-function TGPGraphics.DrawImage(image: TGPImage; x, y: Integer): TStatus;
-var
- nImage: GpImage;
-begin
- if Assigned(Image) then
- nImage := Image.nativeImage
- else
- nImage := nil;
-
- Result := SetStatus(GdipDrawImageI(nativeGraphics, nimage, x, y));
-end;
-
-function TGPGraphics.DrawImageRect(image: TGPImage; x, y, w, h: Integer): TStatus;
-var
- nImage: GpImage;
-begin
- if Assigned(Image) then
- nImage := Image.nativeImage
- else
- nImage := nil;
-
- Result := SetStatus(GdipDrawImageRect(nativeGraphics, nimage, x, y, w, h));
-end;
-
-
-function TGPGraphics.DrawImage(image: TGPImage; const destRect: TGPRectF; srcx, srcy, srcwidth, srcheight: Single;
- srcUnit: TUnit; imageAttributes: TGPImageAttributes = nil; callback: DrawImageAbort = nil;
- callbackData: Pointer = nil): TStatus;
-var
- nImage: GpImage;
- nimageAttributes: GpimageAttributes;
-begin
- if assigned(Image) then nImage := Image.nativeImage else nImage := nil;
- if assigned(imageAttributes) then nimageAttributes := imageAttributes.nativeImageAttr else nimageAttributes := nil;
- result := SetStatus(GdipDrawImageRectRect(nativeGraphics,
- nimage,
- destRect.X,
- destRect.Y,
- destRect.Width,
- destRect.Height,
- srcx, srcy,
- srcwidth, srcheight,
- srcUnit,
- nimageAttributes,
- callback,
- callbackData));
-end;
-
-constructor TGPImage.Create(filename: WideString;
- useEmbeddedColorManagement: BOOL = FALSE);
-begin
- nativeImage := nil;
- if(useEmbeddedColorManagement) then
- begin
- lastResult := GdipLoadImageFromFileICM(PWideChar(filename), nativeImage);
- end
- else
- begin
- lastResult := GdipLoadImageFromFile(PWideChar(filename), nativeImage);
- end;
-end;
-
-constructor TGPImage.Create(stream: IStream;
- useEmbeddedColorManagement: BOOL = FALSE);
-begin
- nativeImage := nil;
- if (useEmbeddedColorManagement) then
- lastResult := GdipLoadImageFromStreamICM(stream, nativeImage)
- else
- lastResult := GdipLoadImageFromStream(stream, nativeImage);
-end;
-
-destructor TGPImage.Destroy;
-begin
- GdipDisposeImage(nativeImage);
-end;
-
-function TGPImage.Save(filename: WideString; const clsidEncoder: TGUID;
- encoderParams: PEncoderParameters = nil): TStatus;
-begin
- result := SetStatus(GdipSaveImageToFile(nativeImage,
- PWideChar(filename),
- @clsidEncoder,
- encoderParams));
-end;
-
-
-function TGPImage.GetFormat: TGPImageFormat;
-var
- format: TGUID;
-begin
- GdipGetImageRawFormat(nativeImage, @format);
-
- Result := ifUndefined;
-
- if IsEqualGUID(format, ImageFormatMemoryBMP) then
- Result := ifMemoryBMP;
-
- if IsEqualGUID(format, ImageFormatBMP) then
- Result := ifBMP;
-
- if IsEqualGUID(format, ImageFormatEMF) then
- Result := ifEMF;
-
- if IsEqualGUID(format, ImageFormatWMF) then
- Result := ifWMF;
-
- if IsEqualGUID(format, ImageFormatJPEG) then
- Result := ifJPEG;
-
- if IsEqualGUID(format, ImageFormatGIF) then
- Result := ifGIF;
-
- if IsEqualGUID(format, ImageFormatPNG) then
- Result := ifPNG;
-
- if IsEqualGUID(format, ImageFormatTIFF) then
- Result := ifTIFF;
-
- if IsEqualGUID(format, ImageFormatEXIF) then
- Result := ifEXIF;
-
- if IsEqualGUID(format, ImageFormatIcon) then
- Result := ifIcon;
-end;
-
-function TGPImage.GetHeight: UINT;
-var
- height: UINT;
-
-begin
- height := 0;
- SetStatus(GdipGetImageHeight(nativeImage, height));
- result := height;
-end;
-
-function TGPImage.GetHorizontalResolution: Single;
-var
- resolution: Single;
-begin
- resolution := 0.0;
- SetStatus(GdipGetImageHorizontalResolution(nativeImage, resolution));
- result := resolution;
-end;
-
-function TGPImage.GetVerticalResolution: Single;
-var
- resolution: Single;
-begin
- resolution := 0.0;
- SetStatus(GdipGetImageVerticalResolution(nativeImage, resolution));
- result := resolution;
-end;
-
-function TGPImage.GetWidth: UINT;
-var
- width: UINT;
-begin
- width := 0;
- SetStatus(GdipGetImageWidth(nativeImage, width));
- result := width;
-end;
-
-constructor TGPImage.Create(nativeImage: GpImage; status: TStatus);
-begin
- SetNativeImage(nativeImage);
- lastResult := status;
-end;
-
-procedure TGPImage.SetNativeImage(nativeImage: GpImage);
-begin
- self.nativeImage := nativeImage;
-end;
-
-function TGPImage.SetStatus(status: TStatus): TStatus;
-begin
- if (status <> Ok) then lastResult := status;
- result := status;
-end;
-
-
-function TGPGraphicsPath.AddLines(points: PGPPoint; count: Integer): TStatus;
-begin
- result := SetStatus(GdipAddPathLine2I(nativePath, points, count));
-end;
-
-function TGPGraphicsPath.AddPie(rect: TGPRectF; startAngle,
- sweepAngle: Single): TStatus;
-begin
- result := AddPie(rect.X, rect.Y, rect.Width, rect.Height, startAngle, sweepAngle);
-end;
-
-function TGPGraphicsPath.AddPie(x, y, width, height, startAngle,
- sweepAngle: Single): TStatus;
-begin
- result := SetStatus(GdipAddPathPie(nativePath, x, y, width, height, startAngle, sweepAngle));
-end;
-
-function TGPGraphicsPath.AddPolygon(points: PGPPointF;
- count: Integer): TStatus;
-begin
- result := SetStatus(GdipAddPathPolygon(nativePath, points, count));
-end;
-
-function TGPGraphicsPath.AddPolygon(points: PGPPoint;
- count: Integer): TStatus;
-begin
- result := SetStatus(GdipAddPathPolygonI(nativePath, points, count));
-end;
-
-function TGPGraphicsPath.AddCurve(points: PGPPointF;
- count: Integer): TStatus;
-begin
- result := SetStatus(GdipAddPathCurve(nativePath, points, count));
-end;
-
-function TGPGraphicsPath.AddCurve(points: PGPPoint;
- count: Integer): TStatus;
-begin
- result := SetStatus(GdipAddPathCurveI(nativePath, points, count));
-end;
-
-function TGPGraphicsPath.AddCurve(points: PGPPoint; count: Integer; tension: Single): TStatus;
-begin
- result := SetStatus(GdipAddPathCurve2I(nativePath, points, count, tension));
-end;
-
-function TGPGraphicsPath.AddBezier(pt1, pt2, pt3, pt4: TGPPoint): TStatus;
-begin
- result := AddBezier(pt1.X, pt1.Y, pt2.X, pt2.Y, pt3.X, pt3.Y, pt4.X, pt4.Y);
-end;
-
-function TGPGraphicsPath.AddBezier(pt1, pt2, pt3, pt4: TGPPointF): TStatus;
-begin
- result := AddBezier(pt1.X, pt1.Y, pt2.X, pt2.Y, pt3.X, pt3.Y, pt4.X, pt4.Y);
-end;
-
-function TGPGraphicsPath.AddBezier(x1, y1, x2, y2, x3, y3, x4,
- y4: Single): TStatus;
-begin
- result := SetStatus(GdipAddPathBezier(nativePath, x1, y1, x2, y2, x3, y3, x4, y4));
-end;
-
-//------------------------------------------------------------------------------
-
-function TGPGraphics.FillPath(brush: TGPBrush;
- path: TGPGraphicsPath): TStatus;
-begin
- result := SetStatus(GdipFillPath(nativeGraphics, brush.nativeBrush, path.nativePath));
-end;
-
-function TGPGraphics.ExcludeClip(const rect: TGPRectF): TStatus;
-begin
- result := SetStatus(GdipSetClipRect(nativeGraphics, rect.X, rect.Y, rect.Width, rect.Height, CombineModeExclude));
-end;
-
-function TGPGraphics.ExcludeClip(region: TGPRegion): TStatus;
-begin
- result := SetStatus(GdipSetClipRegion(nativeGraphics, region.nativeRegion, CombineModeExclude));
-end;
-
-function TGPGraphics.SetClip(region: TGPRegion;
- combineMode: TCombineMode): TStatus;
-begin
- result := SetStatus(GdipSetClipRegion(nativeGraphics, region.nativeRegion, combineMode));
-end;
-
-function TGPGraphics.ResetClip: TStatus;
-begin
- result := SetStatus(GdipResetClip(nativeGraphics));
-end;
-
-function MakeColor(a, r, g, b: Byte): ARGB; overload;
-begin
- result := ((DWORD(b) shl BlueShift) or
- (DWORD(g) shl GreenShift) or
- (DWORD(r) shl RedShift) or
- (DWORD(a) shl AlphaShift));
-end;
-
-function MakeColor(r, g, b: Byte): ARGB; overload;
-begin
- result := MakeColor(255, r, g, b);
-end;
-
-function GetAlpha(color: ARGB): BYTE;
-begin
- result := BYTE(color shr AlphaShift);
-end;
-
-function GetRed(color: ARGB): BYTE;
-begin
- result := BYTE(color shr RedShift);
-end;
-
-function GetGreen(color: ARGB): BYTE;
-begin
- result := BYTE(color shr GreenShift);
-end;
-
-function GetBlue(color: ARGB): BYTE;
-begin
- result := BYTE(color shr BlueShift);
-end;
-
-function TGPGraphics.GetCompositingQuality: TCompositingQuality;
-begin
- SetStatus(GdipGetCompositingQuality(nativeGraphics, result));
-end;
-
-function TGPGraphics.SetCompositingQuality(
- compositingQuality: TCompositingQuality): TStatus;
-begin
- result := SetStatus(GdipSetCompositingQuality( nativeGraphics, compositingQuality));
-end;
-
-function TGPImage.RotateFlip(rotateFlipType: TRotateFlipType): TStatus;
-begin
- Result := SetStatus(GdipImageRotateFlip(nativeImage, rotateFlipType));
-end;
-
-
-{ TGPBitmap }
-
-constructor TGPBitmap.Create(stream: IStream; useEmbeddedColorManagement: BOOL);
-var
- bitmap: GpBitmap;
-begin
- bitmap := nil;
- if(useEmbeddedColorManagement) then
- lastResult := GdipCreateBitmapFromStreamICM(stream, bitmap)
- else
- lastResult := GdipCreateBitmapFromStream(stream, bitmap);
- SetNativeImage(bitmap);
-end;
-
-constructor TGPBitmap.Create(nativeBitmap: GpBitmap);
-begin
- lastResult := Ok;
- SetNativeImage(nativeBitmap);
-end;
-
-constructor TGPBitmap.Create(width, height: Integer; format: TPixelFormat);
-var
- bitmap: GpBitmap;
-begin
- bitmap := nil;
- lastResult := GdipCreateBitmapFromScan0(width, height, 0, format, nil, bitmap);
- SetNativeImage(bitmap);
-end;
-
-function TGPBitmap.FromStream(stream: IStream;
- useEmbeddedColorManagement: BOOL): TGPBitmap;
-begin
- Result := TGPBitmap.Create(stream, useEmbeddedColorManagement);
-end;
-
-function TGPBitmap.GetPixel(x, y: Integer; out color: TGPColor): TStatus;
-begin
- Result := SetStatus(GdipBitmapGetPixel(GpBitmap(nativeImage), x, y, color));
-end;
-
-function TGPBitmap.SetPixel(x, y: Integer; color: TGPColor): TStatus;
-begin
- Result := SetStatus(GdipBitmapSetPixel(GpBitmap(nativeImage), x, y, color));
-end;
-
-
-
-function TGPBitmap.SetResolution(xdpi, ydpi: Single): TStatus;
-begin
- Result := SetStatus(GdipBitmapSetResolution(GpBitmap(nativeImage), xdpi, ydpi));
-end;
-
-{ TGPImageAttributes }
-
-constructor TGPImageAttributes.Create;
-begin
- nativeImageAttr := nil;
- lastResult := GdipCreateImageAttributes(nativeImageAttr);
-end;
-
-destructor TGPImageAttributes.Destroy;
-begin
- GdipDisposeImageAttributes(nativeImageAttr);
- inherited Destroy;
-end;
-
-function TGPImageAttributes.SetStatus(status: TStatus): TStatus;
-begin
- if (status <> Ok) then lastResult := status;
- result := status;
-end;
-
-function TGPImageAttributes.SetColorKey(colorLow, colorHigh: TGPColor;
- type_: TColorAdjustType = ColorAdjustTypeDefault): TStatus;
-begin
- result := SetStatus(GdipSetImageAttributesColorKeys(nativeImageAttr, type_,
- TRUE, colorLow, colorHigh));
-end;
-
-function TGPImageAttributes.ClearColorKey(type_: TColorAdjustType = ColorAdjustTypeDefault): TStatus;
-begin
- result := SetStatus(GdipSetImageAttributesColorKeys(nativeImageAttr, type_,
- FALSE, 0, 0));
-end;
-
-initialization
-begin
- // Initialize StartupInput structure
- StartupInput.DebugEventCallback := nil;
-
- //StartupInput.SuppressBackgroundThread := False;
- StartupInput.SuppressBackgroundThread := True;
- StartupInput.SuppressExternalCodecs := False;
- StartupInput.GdiplusVersion := 1;
-
- StartupOutput.NotificationHook := nil;
- StartupOutput.NotificationUnhook := nil;
-
- // Initialize GDI+
- GdiplusStartup(gdiplusToken, @StartupInput, @StartupOutput);
-end;
-
-finalization
-begin
- // Close GDI +
- if not IsLibrary then
- GdiplusShutdown(gdiplusToken);
-end;
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advglowbutton.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/advglowbutton.pas
deleted file mode 100644
index f34f396..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advglowbutton.pas
+++ /dev/null
@@ -1,6099 +0,0 @@
-{***************************************************************************}
-{ TAdvGlowButton component }
-{ for Delphi & C++Builder }
-{ }
-{ written by TMS Software }
-{ copyright © 2006 - 2009 }
-{ 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 AdvGlowButton;
-
-{$R ADVGLOWBUTTONDB.RES}
-
-{$I TMSDEFS.INC}
-
-{$T-}
-
-interface
-
-uses
- Classes, Windows, Forms, Dialogs, Controls, Graphics, Messages, ExtCtrls,
- SysUtils, Math, Menus, ImgList, AdvGDIP, GDIPicture, ActnList,
- AdvHintInfo, AdvStyleIF, ActiveX
- {$IFNDEF TMS_STD}
- , DB
- {$ENDIF}
- ;
-
-const
- DropDownSectWidth = 13;
-
- MAJ_VER = 1; // Major version nr.
- MIN_VER = 8; // Minor version nr.
- REL_VER = 4; // Release nr.
- BLD_VER = 0; // Build nr.
-
- // version history
- // 1.0.5.1 : Fixed issue with width & height initialization
- // 1.0.5.2 : Improved fade painting
- // 1.1.0.0 : New separate dropdown button hot & down effect
- // : Silver, Blue, Black styles added
- // 1.2.0.0 : New DropDownSplit property added
- // 1.2.0.1 : Fixed issue with ModalResult <> mrNone
- // 1.2.0.2 : Fixed issue with Action handling Checked state
- // 1.2.0.3 : Fixed issue with disabled painting
- // 1.2.0.4 : Fixed issue with key handling
- // 1.3.0.0 : Added new property FocusType
- // : Added new ShortCutHint, ShortCutHintPos & methods ShowShortCutHint, HideShortCutHint
- // 1.3.0.1 : Fixed issue with font and aaNone
- // 1.3.0.2 : Fixed issue with hot & down border painting
- // 1.3.1.0 : New : exposed OnMouseEnter, OnMouseLeave
- // : Fixed issue with Down property for bsCheck style
- // 1.3.1.1 : Fixed issue with Down property for buttons with GroupIndex > 0
- // 1.3.1.2 : Improved transitioning from transparent to hot
- // 1.3.1.3 : Fixed issue with actionlinks & bsCheck type
- // 1.3.2.0 : New styler interface added
- // 1.3.3.0 : New public property DroppedDown added
- // 1.3.4.0 : New TAdvCustomGlowButton.ParentFont added
- // : TButtonLayout blGlyphLeftAdjusted and blGlyphRightAdjusted added
- // 1.3.5.0 : New borderless display possible by setting BorderStyle = bsNone
- // 1.4.0.0 : Improved : seamlessly works with TrueType & non TrueType fonts
- // : New : Spacing property added
- // : New : WordWrap property added
- // : New : AutoSize property added
- // : New : MarginVert property added
- // : New : MarginHorz property added
- // : New : Rounded property added
- // : New : DropDownDirection property added
- // : New : HotImages, HotPicture property added
- // 1.4.5.0 : New : PopupMenu property added
- // : New : OnDrawButton event added
- // : New : TButtonLayout blGlyphTopAdjusted and blGlyphBottomAdjusted added
- // 1.4.6.0 : New : support for Office 2007 silver style added
- // 1.4.6.1 : Fixed : issue with Win98 resource leak
- // 1.5.0.0 : New : support for Unicode text via public property WideCaption
- // : Improved : text drawing in aaNone AntiAlias mode
- // 1.5.0.1 : Fix for use with fonts that are not installed
- // 1.6.0.0 : New : support for Trimming added
- // 1.6.0.1 : Fixed : issue with Action images
- // 1.7.0.0 : New : Repeat functionality added with repeat initial delay & frequency setting
- // : Improved wordwrap drawing with no text aliasing
- // : New : support for using \n newline specifier in property inspector
- // 1.7.0.1 : Fixed : drawing issue with Delphi 2007
- // 1.7.1.0 : New : F4 key to open attached dropdown menu
- // 1.7.1.1 : Fixed : issue with DropDownSplit and OnClick event handler
- // 1.7.2.0 : New : events OnEnter, OnExit added
- // 1.7.2.1 : Improved : painting on MDI child windows
- // 1.7.2.2 : Fixed : drawing issue with Delphi 2007
- // 1.8.0.0 : New : Notes & NotesFont
- // : New : C++Builder 2007 support
- // : Improved : drawing down state for Transparent button
- // : Improved : drawing speed
- // 1.8.0.1 : Fixed : runtime WideCaption assigning causes repaint
- // 1.8.1.0 : Fixed : issue with inherited forms
- // 1.8.1.1 : Fixed : issue with dbl click event
- // : Fixed : issue with actions & groupindex
- // : Fixed : border painting issue on checked buttons in bpMiddle, bpRight position
- // 1.8.1.2 : Fixed : issue with ShowCaption & WideCaption
- // 1.8.1.3 : Fixed : issue with using font not installed on the system
- // 1.8.1.4 : Fixed : issue with WideCaption & aaNone AntiAlias type
- // 1.8.1.5 : Fixed : issue with DblClick & OnClick event
- // 1.8.1.6 : Fixed : issue with AutoCheck action items for bsCheck button type
- // 1.8.1.7 : Fixed : issue with shortcuts on TAdvToolBar
- // : Fixed : issue with dbl click
- // : Improved : dropdown button position
- // 1.8.1.8 : Improved : wordwrapped text drawing for non anti aliased text
- // 1.8.1.9 : Improved : spacing for blGlyphTop, blGlyphTopAdjusted setting
- // 1.8.1.10: Improved : assigning images via action
- // 1.8.2.0 : New : shortcut hint position : shpBelowBottomCenter
- // 1.8.2.1 : Fixed : painting issue with default key handling
- // 1.8.2.2 : Fixed : issue with focus border drawing
- // 1.8.2.3 : Fixed : issue with spacing for glyph right / glyph right adjusted
- // 1.8.3.0 : New : exposed DoDropDown method
- // 1.8.3.1 : Fixed : issue with static imagelist versus actionlist imagelist use
- // 1.8.3.2 : Improved : vertical alignment of Notes text & caption with word wrap
- // 1.8.3.3 : Fixed : issue with accelerator key handling and wide captions
- // 1.8.4.0 : Improved : adaptions for use on Windows Vista style ribbon
-
-type
- TAdvCustomGlowButton = class;
- TAdvGlowButton = class;
-
- TGlowState = (gsHover, gsPush, gsNone);
- TAdvButtonStyle = (bsButton, bsCheck);
- TAdvButtonState = (absUp, absDisabled, absDown, absDropDown, absExclusive);
- TButtonLayout = (blGlyphLeft, blGlyphTop, blGlyphRight, blGlyphBottom,
- blGlyphLeftAdjusted, blGlyphRightAdjusted,
- blGlyphTopAdjusted, blGlyphBottomAdjusted);
-
- TDropDownPosition = (dpRight, dpBottom);
- TDropDownDirection = (ddDown, ddRight);
- TGDIPGradient = (ggRadial, ggVertical, ggDiagonalForward, ggDiagonalBackward);
-
- TFocusType = (ftBorder, ftHot, ftHotBorder, ftNone);
-
- TShortCutHintPos = (shpLeft, shpTop, shpRight, shpBottom, shpCenter, shpAuto,
- shpTopLeft, shpTopRight, shpAboveTop, shpAboveTopLeft,
- shpAboveTopRight, shpBottomLeft, shpBottomRight, shpBelowBottom,
- shpBelowBottomLeft, shpBelowBottomRight, shpBelowBottomCenter);
-
- TButtonPosition = (bpStandalone, bpLeft, bpMiddle, bpRight);
-
- TGlowButtonState = (gsNormal, gsHot, gsDown);
-
- TButtonSizeState = (bsGlyph, bsLabel, bsLarge);
-
- TGlowButtonDrawEvent = procedure(Sender: TObject; Canvas: TCanvas; Rect: TRect; State: TGlowButtonState) of object;
- TSetButtonSizeEvent = procedure(Sender: TObject; var W, H: Integer) of object;
- TOnGetShortCutHintPos = procedure(Sender: TObject; ButtonSizeState: TButtonSizeState; var ShortCutHintPosition: TShortCutHintPos) of object;
-
- TWinCtrl = class(TWinControl)
- public
- procedure PaintCtrls(DC: HDC; First: TControl);
- end;
-
-{$IFDEF DELPHI6_LVL}
- TAdvGlowButtonActionLink = class(TControlActionLink)
- protected
- FImageIndex: Integer;
- FClient: TAdvCustomGlowButton; //TAdvGlowButton;
- procedure AssignClient(AClient: TObject); override;
- function IsCheckedLinked: Boolean; override;
- function IsGroupIndexLinked: Boolean; override;
- procedure SetGroupIndex(Value: Integer); override;
- procedure SetChecked(Value: Boolean); override;
- function IsImageIndexLinked: Boolean; override;
- procedure SetImageIndex(Value: Integer); override;
- end;
-{$ENDIF}
-
- TShortCutHintWindow = class(THintWindow)
- private
- FColor: TColor;
- FColorTo: TColor;
- procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
- protected
- procedure Resize; override;
- procedure Paint; override;
- procedure CreateParams(var Params:TCreateParams);override;
- published
- property Color: TColor read FColor write FColor;
- property ColorTo: TColor read FColorTo write FColorTo;
- end;
-
- TGlowButtonAppearance = class(TPersistent)
- private
- FOnChange: TNotifyEvent;
- FBorderColor: TColor;
- FBorderColorHot: TColor;
- FBorderColorDown: TColor;
- FColor: TColor;
- FColorTo: TColor;
- FColorDown: TColor;
- FColorDownTo: TColor;
- FColorHot: TColor;
- FColorHotTo: TColor;
- FColorCheckedTo: TColor;
- FBorderColorDisabled: TColor;
- FBorderColorChecked: TColor;
- FColorDisabled: TColor;
- FColorDisabledTo: TColor;
- FColorChecked: TColor;
- FColorMirror: TColor;
- FColorMirrorTo: TColor;
- FColorMirrorHot: TColor;
- FColorMirrorHotTo: TColor;
- FColorMirrorDown: TColor;
- FColorMirrorDownTo: TColor;
- FGradientDown: TGDIPGradient;
- FGradientMirror: TGDIPGradient;
- FGradientMirrorHot: TGDIPGradient;
- FGradient: TGDIPGradient;
- FGradientMirrorDown: TGDIPGradient;
- FGradientHot: TGDIPGradient;
- FColorMirrorDisabledTo: TColor;
- FColorMirrorDisabled: TColor;
- FColorMirrorCheckedTo: TColor;
- FColorMirrorChecked: TColor;
- FGradientChecked: TGDIPGradient;
- FGradientDisabled: TGDIPGradient;
- FGradientMirrorChecked: TGDIPGradient;
- FGradientMirrorDisabled: TGDIPGradient;
- FSystemFont: boolean;
- procedure SetSystemFont(const Value: boolean);
- procedure SetBorderColor(const Value: TColor);
- procedure SetBorderColorChecked(const Value: TColor);
- procedure SetBorderColorDisabled(const Value: TColor);
- procedure SetBorderColorDown(const Value: TColor);
- procedure SetBorderColorHot(const Value: TColor);
- procedure SetColor(const Value: TColor);
- procedure SetColorChecked(const Value: TColor);
- procedure SetColorCheckedTo(const Value: TColor);
- procedure SetColorDisabled(const Value: TColor);
- procedure SetColorDisabledTo(const Value: TColor);
- procedure SetColorDown(const Value: TColor);
- procedure SetColorDownTo(const Value: TColor);
- procedure SetColorHot(const Value: TColor);
- procedure SetColorHotTo(const Value: TColor);
- procedure SetColorMirror(const Value: TColor);
- procedure SetColorMirrorChecked(const Value: TColor);
- procedure SetColorMirrorCheckedTo(const Value: TColor);
- procedure SetColorMirrorDisabled(const Value: TColor);
- procedure SetColorMirrorDisabledTo(const Value: TColor);
- procedure SetColorMirrorDown(const Value: TColor);
- procedure SetColorMirrorDownTo(const Value: TColor);
- procedure SetColorMirrorHot(const Value: TColor);
- procedure SetColorMirrorHotTo(const Value: TColor);
- procedure SetColorMirrorTo(const Value: TColor);
- procedure SetColorTo(const Value: TColor);
- procedure SetGradient(const Value: TGDIPGradient);
- procedure SetGradientChecked(const Value: TGDIPGradient);
- procedure SetGradientDisabled(const Value: TGDIPGradient);
- procedure SetGradientDown(const Value: TGDIPGradient);
- procedure SetGradientHot(const Value: TGDIPGradient);
- procedure SetGradientMirror(const Value: TGDIPGradient);
- procedure SetGradientMirrorChecked(const Value: TGDIPGradient);
- procedure SetGradientMirrorDisabled(const Value: TGDIPGradient);
- procedure SetGradientMirrorDown(const Value: TGDIPGradient);
- procedure SetGradientMirrorHot(const Value: TGDIPGradient);
- protected
- procedure Changed;
- public
- constructor Create;
- procedure Assign(Source: TPersistent); override;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- published
- property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver;
- property BorderColorHot: TColor read FBorderColorHot write SetBorderColorHot default clBlue;
- property BorderColorDown: TColor read FBorderColorDown write SetBorderColorDown default clNavy;
- property BorderColorChecked: TColor read FBorderColorChecked write SetBorderColorChecked default clBlue;
- property BorderColorDisabled: TColor read FBorderColorDisabled write SetBorderColorDisabled default clGray;
- property Color: TColor read FColor write SetColor default clWhite;
- property ColorTo: TColor read FColorTo write SetColorTo default clWhite;
- property ColorChecked: TColor read FColorChecked write SetColorChecked;
- property ColorCheckedTo: TColor read FColorCheckedTo write SetColorCheckedTo;
- property ColorDisabled: TColor read FColorDisabled write SetColorDisabled;
- property ColorDisabledTo: TColor read FColorDisabledTo write SetColorDisabledTo;
- property ColorDown: TColor read FColorDown write SetColorDown;
- property ColorDownTo: TColor read FColorDownTo write SetColorDownTo;
- property ColorHot: TColor read FColorHot write SetColorHot;
- property ColorHotTo: TColor read FColorHotTo write SetColorHotTo;
- property ColorMirror: TColor read FColorMirror write SetColorMirror default clSilver;
- property ColorMirrorTo: TColor read FColorMirrorTo write SetColorMirrorTo default clWhite;
- property ColorMirrorHot: TColor read FColorMirrorHot write SetColorMirrorHot;
- property ColorMirrorHotTo: TColor read FColorMirrorHotTo write SetColorMirrorHotTo;
- property ColorMirrorDown: TColor read FColorMirrorDown write SetColorMirrorDown;
- property ColorMirrorDownTo: TColor read FColorMirrorDownTo write SetColorMirrorDownTo;
- property ColorMirrorChecked: TColor read FColorMirrorChecked write SetColorMirrorChecked;
- property ColorMirrorCheckedTo: TColor read FColorMirrorCheckedTo write SetColorMirrorCheckedTo;
- property ColorMirrorDisabled: TColor read FColorMirrorDisabled write SetColorMirrorDisabled;
- property ColorMirrorDisabledTo: TColor read FColorMirrorDisabledTo write SetColorMirrorDisabledTo;
- property Gradient: TGDIPGradient read FGradient write SetGradient default ggVertical;
- property GradientMirror: TGDIPGradient read FGradientMirror write SetGradientMirror default ggVertical;
- property GradientHot: TGDIPGradient read FGradientHot write SetGradientHot default ggRadial;
- property GradientMirrorHot: TGDIPGradient read FGradientMirrorHot write SetGradientMirrorHot default ggRadial;
- property GradientDown: TGDIPGradient read FGradientDown write SetGradientDown default ggRadial;
- property GradientMirrorDown: TGDIPGradient read FGradientMirrorDown write SetGradientMirrorDown default ggRadial;
- property GradientChecked: TGDIPGradient read FGradientChecked write SetGradientChecked default ggRadial;
- property GradientMirrorChecked: TGDIPGradient read FGradientMirrorChecked write SetGradientMirrorChecked default ggVertical;
- property GradientDisabled: TGDIPGradient read FGradientDisabled write SetGradientDisabled default ggRadial;
- property GradientMirrorDisabled: TGDIPGradient read FGradientMirrorDisabled write SetGradientMirrorDisabled default ggRadial;
- property SystemFont: boolean read FSystemFont write SetSystemFont default true;
- end;
-
- /// Button with glow hover & down effect
- TAdvCustomGlowButton = class(TCustomControl, ITMSStyle)
- private
- FActive: Boolean;
- FDown: Boolean;
- FLeftDown: Boolean;
- FMouseDown: Boolean;
- FTimer: TTimer;
- FStepHover: Integer;
- FStepPush: Integer;
- FTimeInc: Integer;
- FGlowState: TGlowState;
- FImages: TImageList;
- FImageIndex: TImageIndex;
- FState: TAdvButtonState;
- FMouseInControl: Boolean;
- FMouseEnter: Boolean;
- FDownChecked: Boolean;
- FInitialDown: Boolean;
- FDragging: Boolean;
- FStyle: TAdvButtonStyle;
- FGroupIndex: Integer;
- FAllowAllUp: Boolean;
- FTransparent: Boolean;
- FLayout: TButtonLayout;
- FDropDownButton: Boolean;
- FDropDownSplit: Boolean;
- FDropDownDirection: TDropDownDirection;
- FDropDownMenu: TPopupMenu;
- FOnDropDown: TNotifyEvent;
- FDropDownPosition: TDropDownPosition;
- FAppearance: TGlowButtonAppearance;
- FDisabledImages: TImageList;
- FInternalImages: TImageList;
- FHotImages: TImageList;
- FIPicture: TGDIPPicture;
- FIDisabledPicture: TGDIPPicture;
- FIHotPicture: TGDIPPicture;
- FShowCaption: Boolean;
- FAntiAlias: TAntiAlias;
- FModalResult: TModalResult;
- FDefault: boolean;
- FCancel: Boolean;
- FInButton: Boolean;
- FBorderStyle: TBorderStyle;
- FButtonPosition: TButtonPosition;
- FOfficeHint: TAdvHintInfo;
- FCheckLinked: Boolean;
- FGroupIndexLinked: Boolean;
- FFocusType: TFocusType;
- FShortCutHint: TShortCutHintWindow;
- FShortCutHintPos: TShortCutHintPos;
- FShortCutHintText: string;
- FShowDisabled: Boolean;
- FOnInternalKeyDown: TKeyEvent;
- FOnMouseLeave: TNotifyEvent;
- FOnMouseEnter: TNotifyEvent;
- FDroppedDown: Boolean;
- FOverlappedText: Boolean;
- FSpacing: Integer;
- FAutoSize: Boolean;
- FWordWrap: Boolean;
- FDoAutoSize: Boolean;
- FFirstPaint: Boolean;
- FMarginVert: integer;
- FMarginHorz: integer;
- FRounded: Boolean;
- FOnDrawButton: TGlowButtonDrawEvent;
- FWideCaption: widestring;
- FTrimming: TStringTrimming;
- FRepeatTimer: TTimer;
- FInitRepeatPause: Integer;
- FRepeatPause: Integer;
- FRepeatClick: Boolean;
- FPainting: Boolean;
- FOnInternalClick: TNotifyEvent;
- FButtonSizeState: TButtonSizeState;
- FMaxButtonSizeState: TButtonSizeState;
- FOnSetButtonSize: TSetButtonSizeEvent;
- FOldLayout: TButtonLayout;
- FOldDropDownPosition: TDropDownPosition;
- FMinButtonSizeState: TButtonSizeState;
- FParentForm: TCustomForm;
- FIsVista: boolean;
- FNotes: TStringList;
- FNotesFont: TFont;
- FGotButtonClick: boolean;
- FOnGetShortCutHintPos: TOnGetShortCutHintPos;
- FHasFocus: boolean;
- {$IFDEF DELPHI2006_LVL}
- class var FStaticActionImageIndex: boolean;
- {$ENDIF}
- procedure SetOfficeHint(const Value: TAdvHintInfo);
- procedure SetButtonPosition(const Value: TButtonPosition);
- procedure SetBorderStyle(const Value: TBorderStyle);
- function GetVersion: string;
- procedure SetVersion(const Value: string);
- procedure SetDefault(const Value: boolean);
- procedure SetAntiAlias(const Value: TAntiAlias);
- procedure SetShowCaption(const Value: Boolean);
- procedure SetDisabledPicture(const Value: TGDIPPicture);
- procedure SetHotPicture(const Value: TGDIPPicture);
- procedure SetPicture(const Value: TGDIPPicture);
- procedure SetTransparent(const Value: Boolean);
- procedure UpdateExclusive;
- procedure UpdateTracking;
- procedure SetImageIndex(const Value: TImageIndex);
- procedure SetImages(const Value: TImageList);
- procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
- procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
- procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
- procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
- procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
- procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
- procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
- procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
- procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
- procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
- procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
- procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
-{$IFNDEF TMSDOTNET}
- procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
-{$ENDIF}
- procedure WMLButtonDown(var Msg:TWMLButtonDown); message WM_LBUTTONDOWN;
- procedure WMLButtonUp(var Msg:TWMLButtonDown); message WM_LBUTTONUP;
- procedure WMLDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
- procedure TimerProc(Sender: TObject);
- procedure OnAppearanceChanged(Sender: TObject);
- procedure SetDown(Value: Boolean);
- procedure SetStyle(const Value: TAdvButtonStyle);
- procedure SetGroupIndex(const Value: Integer);
- procedure SetAllowAllUp(const Value: Boolean);
- procedure SetLayout(const Value: TButtonLayout);
- procedure SetDropDownButton(const Value: Boolean);
- procedure PopupBtnDown;
- procedure SetDropDownPosition(const Value: TDropDownPosition);
- procedure SetDropDownDirection(const Value: TDropDownDirection);
- procedure SetAppearance(const Value: TGlowButtonAppearance);
- procedure SetDisabledImages(const Value: TImageList);
- procedure PictureChanged(Sender: TObject);
- procedure SetSpacing(const Value: integer);
- procedure SetAutoSizeEx(const Value: boolean);
- procedure SetShowDisabled(const Value: boolean);
- procedure SetWordWrap(const Value: boolean);
- procedure SetMarginVert(const Value: integer);
- procedure SetMarginHorz(const Value: integer);
- procedure SetRounded(const Value: boolean);
- procedure SetTrimming(const Value: TStringTrimming);
- procedure PerformResize;
- function IsFontStored: Boolean;
- procedure SetButtonSizeState(const Value: TButtonSizeState);
- procedure SetMaxButtonSizeState(const Value: TButtonSizeState);
- procedure SetMinButtonSizeState(const Value: TButtonSizeState);
- procedure SetNotes(const Value: TStrings);
- function GetNotes: TStrings;
- procedure SetNotesFont(const Value: TFont);
- procedure SetWideCaption(const Value: widestring);
- {$IFDEF DELPHI6_LVL}
- function ActionHasImages: boolean;
- {$ENDIF}
-// procedure SetCaption(const Value: string);
-// function GetCaption: string;
- protected
- FHot: Boolean;
- FDefaultPicDrawing: Boolean;
- FDefaultCaptionDrawing: Boolean;
- FCustomizerCreated: Boolean;
- FCommandID: Integer;
- procedure TimerExpired(Sender: TObject); virtual;
- procedure DrawGlyphCaption; virtual;
- procedure GetToolImage(bmp: TBitmap); virtual;
- procedure SetDroppedDown(Value: Boolean);
- procedure CreateParams(var Params:TCreateParams); override;
- procedure Paint; override;
- procedure Loaded; override;
- procedure DoEnter; override;
- procedure DoExit; override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure KeyUp(var Key: Word; Shift: TShiftState); override;
- procedure KeyPress(var Key: Char); override;
-{$IFDEF DELPHI6_LVL}
- function GetActionLinkClass: TControlActionLinkClass; override;
- procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
-{$ENDIF}
- procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
- property GlowState: TGlowState read FGlowState write FGlowState;
-{$IFDEF TMSDOTNET}
- procedure ButtonPressed(Group: Integer; Button: TAdvGlowButton);
-{$ENDIF}
- property Down: Boolean read FDownChecked write SetDown default False;
- property Style: TAdvButtonStyle read FStyle write SetStyle default bsButton;
- property State: TAdvButtonState read FState write FState;
- property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
- property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
- property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
- property DroppedDown: Boolean read FDroppedDown;
- property DropDownButton: Boolean read FDropDownButton write SetDropDownButton default False;
- property DropDownDirection: TDropDownDirection read FDropDownDirection write SetDropDownDirection default ddDown;
- property DropDownPosition: TDropDownPosition read FDropDownPosition write SetDropDownPosition default dpRight;
- property DropDownSplit: Boolean read FDropDownSplit write FDropDownSplit default true;
- property DropDownMenu: TPopupMenu read FDropDownMenu write FDropDownMenu;
- property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
- function GetVersionNr: Integer; virtual;
- function IsMenuButton: Boolean; virtual;
- function CanDrawBorder: Boolean; virtual;
- function CanDrawFocused: Boolean; virtual;
- procedure InternalClick;
- property CheckLinked: Boolean read FCheckLinked write FCheckLinked;
- property GroupIndexLinked: Boolean read FGroupIndexLinked write FGroupIndexLinked;
- property OnInternalKeyDown: TKeyEvent read FOnInternalKeyDown write FOnInternalKeyDown; // Used by AdvToolBar
- property OnInternalClick: TNotifyEvent read FOnInternalClick write FOnInternalClick; // Used by AdvToolBar
- property OnGetShortCutHintPos: TOnGetShortCutHintPos read FOnGetShortCutHintPos write FOnGetShortCutHintPos; // Used by AdvToolBar
- property OverlappedText: boolean read FOverlappedText write FOverlappedText;
- property DoAutoSize: boolean read FDoAutoSize write FDoAutoSize;
- property ButtonSizeState: TButtonSizeState read FButtonSizeState write SetButtonSizeState; // Used by AdvToolBar
- property MaxButtonSizeState: TButtonSizeState read FMaxButtonSizeState write SetMaxButtonSizeState default bsLarge;
- property MinButtonSizeState: TButtonSizeState read FMinButtonSizeState write SetMinButtonSizeState default bsGlyph;
- property OnSetButtonSize: TSetButtonSizeEvent read FOnSetButtonSize write FOnSetButtonSize; // Used by AdvToolBar
- function GetButtonSize(BtnSizeState: TButtonSizeState): TSize;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- procedure CreateWnd; override;
- procedure Click; override;
- procedure DoDropDown;
- property Appearance: TGlowButtonAppearance read FAppearance write SetAppearance;
- procedure ShowShortCutHint;
- procedure HideShortCutHint;
- /// Sets the style of the component, make sure to include AdvStyleIF unit
- procedure SetComponentStyle(AStyle: TTMSStyle);
- property WideCaption: widestring read FWideCaption write SetWideCaption;
- {$IFDEF DELPHI2006_LVL}
- class property StaticActionImageIndex: boolean read FStaticActionImageIndex write FStaticActionImageIndex;
- {$ENDIF}
- published
- property Align;
- property Action;
- property Anchors;
- property AntiAlias: TAntiAlias read FAntiAlias write SetAntiAlias default aaClearType;
- property AutoSize: boolean read FAutoSize write SetAutoSizeEx default false;
- property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
- property Cancel: Boolean read FCancel write FCancel default False;
- //property Caption: string read GetCaption write SetCaption;
- property Caption;
- property Constraints;
- property Default: boolean read FDefault write SetDefault default False;
- property Font stored IsFontStored;
- property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
- property Images: TImageList read FImages write SetImages;
- property DisabledImages: TImageList read FDisabledImages write SetDisabledImages;
- property DisabledPicture: TGDIPPicture read FIDisabledPicture write SetDisabledPicture;
- property DragMode;
- property DragKind;
- property FocusType: TFocusType read FFocusType write FFocusType default ftBorder;
- property HotImages: TImageList read FHotImages write FHotImages;
- property HotPicture: TGDIPPicture read FIHotPicture write SetHotPicture;
- property MarginVert: integer read FMarginVert write SetMarginVert default 1;
- property MarginHorz: integer read FMarginHorz write SetMarginHorz default 1;
- property ModalResult: TModalResult read FModalResult write FModalResult default 0;
- property Notes: TStrings read GetNotes write SetNotes;
- property NotesFont: TFont read FNotesFont write SetNotesFont;
- property OfficeHint: TAdvHintInfo read FOfficeHint write SetOfficeHint;
- property ParentFont default true;
- property Picture: TGDIPPicture read FIPicture write SetPicture;
- property PopupMenu;
- property Position: TButtonPosition read FButtonPosition write SetButtonPosition default bpStandalone;
- property InitRepeatPause: Integer read FInitRepeatPause write FInitRepeatPause default 400;
- property RepeatPause: Integer read FRepeatPause write FRepeatPause default 100;
- property RepeatClick: boolean read FRepeatClick write FRepeatClick default false;
- property Rounded: Boolean read FRounded write SetRounded default true;
- property ShortCutHint: string read FShortCutHintText write FShortCutHintText;
- property ShortCutHintPos: TShortCutHintPos read FShortCutHintPos write FShortCutHintPos default shpTop;
- property ShowCaption: Boolean read FShowCaption write SetShowCaption default true;
- property ShowDisabled: Boolean read FShowDisabled write SetShowDisabled default true;
- property Spacing: Integer read FSpacing write SetSpacing default 2;
- property Transparent: Boolean read FTransparent write SetTransparent default false;
- property Trimming: TStringTrimming read FTrimming write SetTrimming default StringTrimmingNone;
- property Version: string read GetVersion write SetVersion stored False;
- property WordWrap: boolean read FWordWrap write SetWordWrap default true;
- property ParentShowHint;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
- property OnClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDock;
- property OnExit;
- property OnEnter;
-
- property OnStartDock;
- property OnStartDrag;
-
- property OnMouseDown;
- property OnMouseUp;
- property OnMouseMove;
- property OnKeyDown;
- property OnKeyUp;
- property OnKeyPress;
- property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
- property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
- property OnDrawButton: TGlowButtonDrawEvent read FOnDrawButton write FOnDrawButton;
- end;
-
- TAdvGlowButton = class(TAdvCustomGlowButton)
- private
- protected
- public
- property State;
- property DroppedDown;
- published
- property AllowAllUp;
- property Appearance;
- property Down;
- property Enabled;
- property GroupIndex;
- property Layout;
- property Style;
- property MaxButtonSizeState;
- property MinButtonSizeState;
- property DropDownButton;
- property DropDownPosition;
- property DropDownDirection;
- property DropDownSplit;
- property DropDownMenu;
- property OnDropDown;
- end;
-
- {$IFNDEF TMS_STD}
-
- //---- DB aware version
- TDBGlowButtonType = (dbCustom, dbFirst, dbPrior, dbNext, dbLast, dbInsert, dbAppend,
- dbDelete, dbEdit, dbPost, dbCancel, dbRefresh);
-
- TDBBDisableControl = (drBOF, drEOF, drReadonly, drNotEditing, drEditing, drEmpty, drEvent);
- TDBBDisableControls = set of TDBBDisableControl;
-
- TBeforeActionEvent = procedure (Sender: TObject; var DoAction: Boolean) of object;
- TAfterActionEvent = procedure (Sender: TObject; var ShowException: Boolean) of object;
- TGetConfirmEvent = procedure (Sender: TObject; var Question: string; var Buttons: TMsgDlgButtons; var HelpCtx: Longint) of object;
- TGetEnabledEvent = procedure (Sender: TObject; var Enabled: Boolean) of object;
-
- TDBGlowButtonDataLink = class(TDataLink)
- private
- FOnEditingChanged: TNotifyEvent;
- FOnDataSetChanged: TNotifyEvent;
- FOnActiveChanged: TNotifyEvent;
- protected
- procedure EditingChanged; override;
- procedure DataSetChanged; override;
- procedure ActiveChanged; override;
- public
- constructor Create;
- property OnEditingChanged: TNotifyEvent
- read FOnEditingChanged write FOnEditingChanged;
- property OnDataSetChanged: TNotifyEvent
- read FOnDataSetChanged write FOnDataSetChanged;
- property OnActiveChanged: TNotifyEvent
- read FOnActiveChanged write FOnActiveChanged;
- end;
-
- TDBAdvGlowButton = class(TAdvCustomGlowButton)
- private
- FDataLink: TDBGlowButtonDataLink;
- FAutoDisable: Boolean;
- FDisableControls: TDBBDisableControls;
- FOnAfterAction: TAfterActionEvent;
- FOnBeforeAction: TBeforeActionEvent;
- FDBButtonType: TDBGlowButtonType;
- FOnGetConfirm: TGetConfirmEvent;
- FOnGetEnabled: TGetEnabledEvent;
- FOnEnabledChanged: TNotifyEvent;
- FConfirmAction: Boolean;
- FConfirmActionString: String;
- FInProcUpdateEnabled: Boolean;
- procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
- procedure OnDataSetEvents(Sender: TObject);
-
- function GetDataSource: TDataSource;
- procedure SetDataSource(const Value: TDataSource);
- procedure SetDBButtonType(const Value: TDBGlowButtonType);
- procedure SetConfirmActionString(const Value: String);
- protected
- procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
- procedure Loaded; override;
- procedure CalcDisableReasons;
- procedure DoBeforeAction(var DoAction: Boolean); virtual;
- procedure DoGetQuestion(var Question: string; var Buttons: TMsgDlgButtons; var HelpCtx: Longint); virtual;
- function DoConfirmAction: Boolean; virtual;
- procedure DoAction; virtual;
- procedure UpdateEnabled; virtual;
- procedure LoadGlyph; virtual;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure Click; override;
- published
- property Action;
- property Appearance;
- property Layout;
- property Constraints;
- property AutoDisable: Boolean read FAutoDisable write FAutoDisable;
- property ConfirmAction: Boolean read FConfirmAction write FConfirmAction;
- property ConfirmActionString: String read FConfirmActionString write SetConfirmActionString;
- property DataSource: TDataSource read GetDataSource write SetDataSource;
- property DBButtonType: TDBGlowButtonType read FDBButtonType write SetDBButtonType;
- property DisableControl: TDBBDisableControls read FDisableControls write FDisableControls;
- property Enabled;
-
- property OnBeforeAction: TBeforeActionEvent read FOnBeforeAction write FOnBeforeAction;
- property OnAfterAction: TAfterActionEvent read FOnAfterAction write FOnAfterAction;
- property OnGetConfirm: TGetConfirmEvent read FOnGetConfirm write FOnGetConfirm;
- property OnGetEnabled: TGetEnabledEvent read FOnGetEnabled write FOnGetEnabled;
- property OnEnabledChanged: TNotifyEvent read FOnEnabledChanged write FOnEnabledChanged;
- end;
-
- {$ENDIF}
-
-implementation
-
-{$IFNDEF TMS_STD}
-uses
- {$IFDEF DELPHI6_LVL}
- VDBConsts
- {$ELSE}
- DBConsts
- {$ENDIF}
- ;
-{$ENDIF}
-
-type
- TButtonDisplay = (bdNone, bdButton, bdDropDown);
-
-//------------------------------------------------------------------------------
-
-procedure DrawGradient(Canvas: TCanvas; FromColor, ToColor: TColor; Steps: Integer; R: TRect; Direction: Boolean);
-var
- diffr, startr, endr: Integer;
- diffg, startg, endg: Integer;
- diffb, startb, endb: Integer;
- rstepr, rstepg, rstepb, rstepw: Real;
- i, stepw: Word;
-
-begin
- if Steps = 0 then
- Steps := 1;
-
- FromColor := ColorToRGB(FromColor);
- ToColor := ColorToRGB(ToColor);
-
- startr := (FromColor and $0000FF);
- startg := (FromColor and $00FF00) shr 8;
- startb := (FromColor and $FF0000) shr 16;
- endr := (ToColor and $0000FF);
- endg := (ToColor and $00FF00) shr 8;
- endb := (ToColor and $FF0000) shr 16;
-
- diffr := endr - startr;
- diffg := endg - startg;
- diffb := endb - startb;
-
- rstepr := diffr / steps;
- rstepg := diffg / steps;
- rstepb := diffb / steps;
-
- if Direction then
- rstepw := (R.Right - R.Left) / Steps
- else
- rstepw := (R.Bottom - R.Top) / Steps;
-
- with Canvas do
- begin
- for i := 0 to steps - 1 do
- begin
- endr := startr + Round(rstepr * i);
- endg := startg + Round(rstepg * i);
- endb := startb + Round(rstepb * i);
- stepw := Round(i * rstepw);
- Pen.Color := endr + (endg shl 8) + (endb shl 16);
- Brush.Color := Pen.Color;
- if Direction then
- Rectangle(R.Left + stepw, R.Top, R.Left + stepw + Round(rstepw) + 1, R.Bottom)
- else
- Rectangle(R.Left, R.Top + stepw, R.Right, R.Top + stepw + Round(rstepw) + 1);
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function BrightnessColor(Col: TColor; Brightness: integer): TColor; overload;
-var
- r1,g1,b1: Integer;
-begin
- Col := ColorToRGB(Col);
- r1 := GetRValue(Col);
- g1 := GetGValue(Col);
- b1 := GetBValue(Col);
-
- if r1 = 0 then
- r1 := Max(0,Brightness)
- else
- r1 := Round( Min(100,(100 + Brightness))/100 * r1 );
-
- if g1 = 0 then
- g1 := Max(0,Brightness)
- else
- g1 := Round( Min(100,(100 + Brightness))/100 * g1 );
-
- if b1 = 0 then
- b1 := Max(0,Brightness)
- else
- b1 := Round( Min(100,(100 + Brightness))/100 * b1 );
-
- Result := RGB(r1,g1,b1);
-end;
-
-//------------------------------------------------------------------------------
-
-function BrightnessColor(Col: TColor; BR,BG,BB: integer): TColor; overload;
-var
- r1,g1,b1: Integer;
-begin
- Col := Longint(ColorToRGB(Col));
- r1 := GetRValue(Col);
- g1 := GetGValue(Col);
- b1 := GetBValue(Col);
-
- if r1 = 0 then
- r1 := Max(0,BR)
- else
- r1 := Round( Min(100,(100 + BR))/100 * r1 );
-
- if g1 = 0 then
- g1 := Max(0,BG)
- else
- g1 := Round( Min(100,(100 + BG))/100 * g1 );
-
- if b1 = 0 then
- b1 := Max(0,BB)
- else
- b1 := Round( Min(100,(100 + BB))/100 * b1 );
-
- Result := RGB(r1,g1,b1);
-end;
-
-//------------------------------------------------------------------------------
-
-function BlendColor(Col1,Col2:TColor; BlendFactor:Integer): TColor;
-var
- r1,g1,b1: Integer;
- r2,g2,b2: Integer;
-
-begin
- if BlendFactor >= 100 then
- begin
- Result := Col1;
- Exit;
- end;
- if BlendFactor <= 0 then
- begin
- Result := Col2;
- Exit;
- end;
-
- Col1 := Longint(ColorToRGB(Col1));
- r1 := GetRValue(Col1);
- g1 := GetGValue(Col1);
- b1 := GetBValue(Col1);
-
- Col2 := Longint(ColorToRGB(Col2));
- r2 := GetRValue(Col2);
- g2 := GetGValue(Col2);
- b2 := GetBValue(Col2);
-
- r1 := Round( BlendFactor/100 * r1 + (1 - BlendFactor/100) * r2);
- g1 := Round( BlendFactor/100 * g1 + (1 - BlendFactor/100) * g2);
- b1 := Round( BlendFactor/100 * b1 + (1 - BlendFactor/100) * b2);
-
- Result := RGB(r1,g1,b1);
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure DrawOpenRoundRectMiddle(graphics: TGPGraphics; PC: TColor; X,Y,Width,Height,Radius: integer;Hot:boolean);
-var
- path:TGPGraphicsPath;
- gppen:TGPPen;
-
-begin
- path := TGPGraphicsPath.Create;
-
- gppen := tgppen.Create(ColorToARGB(PC),1);
- path.AddLine(X-1, Y + height, X + width, Y + height);
- graphics.DrawPath(gppen, path);
- path.Free;
-
- path := TGPGraphicsPath.Create;
- path.AddLine(X-1, Y, X + width, Y);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
-
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(BrightnessColor(PC,-5)),1);
- path.AddLine(X + Width, Y, X + width, Y + Height);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
-
- if hot then
- begin
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(BrightnessColor(PC,-5)),1);
- path.AddLine(X , Y, X , Y + Height);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
- end
- else
- begin
- path := TGPGraphicsPath.Create;
- // 3D color effect
- gppen := tgppen.Create(ColorToARGB(BrightnessColor(clwhite,-10)),1);
- path.AddLine(X, Y + 2, X, Y + Height - 2);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
- end;
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure DrawOpenRoundRectLeft(graphics: TGPGraphics; PC:TColor; X,Y,Width,Height,Radius: integer);
-var
- path:TGPGraphicsPath;
- gppen:TGPPen;
-begin
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(PC),1);
- path.AddLine(X + width , Y + height, X + radius, Y + height);
- path.AddArc(X, Y + height - (radius*2), radius*2, radius*2, 90, 90);
- path.AddLine(X, Y + height - (radius*2), X, Y + radius);
- path.AddArc(X, Y, radius*2, radius*2, 180, 90);
- path.AddLine(X + radius, Y, X + width, Y);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
-
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(BrightnessColor(PC,-5)),1);
- path.AddLine(X + Width , Y, X + width , Y + Height);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
-
-end;
-
-procedure DrawOpenRoundRectRight(graphics: TGPGraphics; PC: TColor; X,Y,Width,Height,Radius: integer;Hot: boolean);
-var
- path:TGPGraphicsPath;
- gppen:TGPPen;
-begin
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(PC),1);
- path.AddLine(X, Y, X + width - (radius *2), Y);
- path.AddArc(X + width - (radius*2), Y, radius*2, radius*2, 270, 90);
- path.AddLine(X + width, Y + radius, X + width, Y + height - (radius*2));
- path.AddArc(X + width - (radius*2), Y + height - (radius*2), radius*2, radius*2,0,90);
- path.AddLine(X + width , Y + height, X, Y + height);
- graphics.DrawPath(gppen, path);
- gppen.Free;
-
- path.Free;
-
-
- if hot then
- begin
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(BrightnessColor(PC,-5)),1);
- path.AddLine(X , Y, X , Y + Height);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
- end
- else
- begin
- path := TGPGraphicsPath.Create;
- // 3D color effect
- gppen := tgppen.Create(ColorToARGB(BrightnessColor(clwhite,-10)),1);
- path.AddLine(X, Y + 2, X, Y + Height - 2);
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure DrawDottedRoundRect(graphics: TGPGraphics; PC: TColor; X,Y,Width,Height,Radius: integer);
-var
- path:TGPGraphicsPath;
- gppen:TGPPen;
-begin
- path := TGPGraphicsPath.Create;
- gppen := tgppen.Create(ColorToARGB(PC),1);
- gppen.SetDashStyle(DashStyleDot);
- path.AddLine(X + radius, Y, X + width - (radius*2), Y);
- path.AddArc(X + width - (radius*2), Y, radius*2, radius*2, 270, 90);
- path.AddLine(X + width, Y + radius, X + width, Y + height - (radius*2));
- path.AddArc(X + width - (radius*2), Y + height - (radius*2), radius*2, radius*2,0,90);
- path.AddLine(X + width - (radius*2), Y + height, X + radius, Y + height);
- path.AddArc(X, Y + height - (radius*2), radius*2, radius*2, 90, 90);
- path.AddLine(X, Y + height - (radius*2), X, Y + radius);
- path.AddArc(X, Y, radius*2, radius*2, 180, 90);
- path.CloseFigure;
- graphics.DrawPath(gppen, path);
- gppen.Free;
- path.Free;
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure DrawRoundRect(graphics: TGPGraphics; PC: TColor; X,Y,Width,Height,Radius: integer);
-var
- path:TGPGraphicsPath;
- gppen:TGPPen;
- r: integer;
-begin
- gppen := tgppen.Create(ColorToARGB(PC),1);
-
- if radius = 0 then
- begin
- graphics.DrawRectangle(gppen, X, Y, Width, Height);
- end
- else
- begin
- r := radius * 2;
- path := TGPGraphicsPath.Create;
- //gppen := tgppen.Create(ColorToARGB(PC),1);
- path.AddLine(X + radius, Y, X + width - r, Y);
- path.AddArc(X + width - r, Y, r, r, 270, 90);
- path.AddLine(X + width, Y + radius, X + width, Y + height - r);
- path.AddArc(X + width - r, Y + height - r, r, r,0,90);
- path.AddLine(X + width - r, Y + height, X + radius, Y + height);
- path.AddArc(X, Y + height - r, r, r, 90, 90);
- path.AddLine(X, Y + height - r, X, Y + radius);
- path.AddArc(X, Y, r, r, 180, 90);
- path.CloseFigure;
- graphics.DrawPath(gppen, path);
- path.Free;
- end;
- gppen.Free;
-end;
-
-procedure DrawArrow(Canvas: TCanvas; ArP: TPoint; ArClr, ArShad: TColor; Down:boolean);
-begin
- if Down then
- begin
- Canvas.Pen.Color := ArClr;
- Canvas.MoveTo(ArP.X, ArP.Y);
- Canvas.LineTo(ArP.X + 5, ArP.Y);
- Canvas.MoveTo(ArP.X + 1, ArP.Y + 1);
- Canvas.LineTo(ArP.X + 4, ArP.Y + 1);
- Canvas.Pixels[ArP.X + 2, ArP.Y + 2] := ArClr;
- Canvas.Pixels[ArP.X, ArP.Y + 1] := ArShad;
- Canvas.Pixels[ArP.X + 4, ArP.Y + 1] := ArShad;
- Canvas.Pixels[ArP.X + 1, ArP.Y + 2] := ArShad;
- Canvas.Pixels[ArP.X + 3, ArP.Y + 2] := ArShad;
- Canvas.Pixels[ArP.X + 2, ArP.Y + 3] := ArShad;
- end
- else
- begin
- Canvas.Pen.Color := ArClr;
- Canvas.MoveTo(ArP.X, ArP.Y);
- Canvas.LineTo(ArP.X, ArP.Y + 5);
- Canvas.MoveTo(ArP.X + 1, ArP.Y + 1);
- Canvas.LineTo(ArP.X + 1, ArP.Y + 4);
- Canvas.Pixels[ArP.X + 2, ArP.Y + 2] := ArClr;
- Canvas.Pixels[ArP.X + 2, ArP.Y + 1] := ArShad;
- Canvas.Pixels[ArP.X + 1, ArP.Y + 4] := ArShad;
- Canvas.Pixels[ArP.X + 2, ArP.Y + 1] := ArShad;
- Canvas.Pixels[ArP.X + 3, ArP.Y + 2] := ArShad;
- Canvas.Pixels[ArP.X + 3, ArP.Y + 2] := ArShad;
- end;
-end;
-
-procedure DrawButtonBackground(Canvas: TCanvas; Graphics: TGPGraphics; R: TRect; CF,CT: TColor; Gradient: TGDIPGradient; Upper: boolean);
-var
- path: TGPGraphicsPath;
- pthGrBrush: TGPPathGradientBrush;
- linGrBrush: TGPLinearGradientBrush;
- solGrBrush: TGPSolidBrush;
-
- w,h,w2,h2: Integer;
- colors : array[0..0] of TGPColor;
- count: Integer;
-
-begin
- w := r.Right - r.Left;
- h := r.Bottom - r.Top;
-
- h2 := h div 2;
- w2 := w div 2;
-
- {
- // draw background
- if Upper then
- Canvas.Brush.Color := CF
- else
- Canvas.Brush.Color := CT;
- Canvas.FillRect(rect(r.Left , r.Top, r.Right , r.Bottom));
- }
-
- if Upper then
- solGrBrush := TGPSolidBrush.Create(ColorToARGB(CF))
- else
- solGrBrush := TGPSolidBrush.Create(ColorToARGB(CT));
-
- Graphics.FillRectangle(solGrBrush, MakeRect(r.Left , r.Top, r.Right , r.Bottom));
-
- solGrBrush.Free;
-
- // Create a path that consists of a single ellipse.
- path := TGPGraphicsPath.Create;
-
- if Upper then // take borders in account
- path.AddEllipse(r.Left, r.Top - h2 + 2, r.Right , r.Bottom)
- else
- path.AddEllipse(r.Left, r.Top, r.Right , r.Bottom);
-
- pthGrBrush := nil;
- linGrBrush := nil;
-
- case Gradient of
- ggRadial: pthGrBrush := TGPPathGradientBrush.Create(path);
- ggVertical: linGrBrush := TGPLinearGradientBrush.Create(MakeRect(r.Left,r.Top,w,h),ColorToARGB(CF),ColorToARGB(CT), LinearGradientModeVertical);
- ggDiagonalForward: linGrBrush := TGPLinearGradientBrush.Create(MakeRect(r.Left,r.Top,w,h),ColorToARGB(CF),ColorToARGB(CT), LinearGradientModeForwardDiagonal);
- ggDiagonalBackward: linGrBrush := TGPLinearGradientBrush.Create(MakeRect(r.Left,r.Top,w,h),ColorToARGB(CF),ColorToARGB(CT), LinearGradientModeBackwardDiagonal);
- end;
-
- if Gradient = ggRadial then
- begin
- if Upper then
- pthGrBrush.SetCenterPoint(MakePoint(r.Left + w2, r.Top))
- else
- pthGrBrush.SetCenterPoint(MakePoint(r.Left + w2, r.Bottom));
-
- // Set the color at the center point to blue.
- if Upper then
- begin
- pthGrBrush.SetCenterColor(ColorToARGB(CT));
- colors[0] := ColorToARGB(CF);
- end
- else
- begin
- pthGrBrush.SetCenterColor(ColorToARGB(CF));
- colors[0] := ColorToARGB(CT);
- end;
-
- count := 1;
- pthGrBrush.SetSurroundColors(@colors, count);
- graphics.FillRectangle(pthGrBrush, r.Left, r.Top, r.Right, r.Bottom);
- pthGrBrush.Free;
- end
- else
- begin
- graphics.FillRectangle(linGrBrush, r.Left, r.Top, r.Right, r.Bottom);
- linGrBrush.Free;
- end;
-
- path.Free;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure DrawStretchPicture(graphics : TGPGraphics; Canvas: TCanvas; R: TRect; Pic: TGDIPPicture);
-var
- Img: TGPImage;
- pstm: IStream;
- hGlobal: THandle;
- pcbWrite: Longint;
- ms: TMemoryStream;
- bmp: TBitmap;
-begin
- ms := TMemoryStream.Create;
- Pic.SaveToStream(ms);
- hGlobal := GlobalAlloc(GMEM_MOVEABLE, ms.Size);
- if (hGlobal = 0) then
- begin
- ms.Free;
- raise Exception.Create('Could not allocate memory for image');
- end;
-
- try
- pstm := nil;
-
- // Create IStream* from global memory
- CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
- pstm.Write(ms.Memory, ms.Size,@pcbWrite);
-
- Img := TGPImage.Create(pstm);
- if (Img.GetFormat = ifBMP) then
- begin // use this alternative for easy bitmap auto transparent drawing
- bmp := TBitmap.Create;
- ms.Position := 0;
- bmp.LoadFromStream(ms);
- bmp.TransparentMode := tmAuto;
- bmp.Transparent := true;
- Canvas.StretchDraw(R, bmp);
- bmp.Free;
- end
- else
- begin
- graphics.DrawImageRect(Img, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
- end;
-
- Img.Free;
- ms.Free;
- finally
- GlobalFree(hGlobal);
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure DrawGDIPImageFromImageList(graphics: TGPGraphics; P: TPoint; Images: TImageList; ImageIndex: Integer; Enable: Boolean);
-var
- Img: TGPImage;
- pstm: IStream;
- hGlobal: THandle;
- pcbWrite: Longint;
- ms: TMemoryStream;
- ImageAttributes: TGPImageAttributes;
- r, g, b: byte;
- GPBmp: TGPBitmap;
- Aclr: TGPColor;
- bmp: TBitmap;
-begin
- if not Assigned(Images) or (ImageIndex < 0) or not Assigned(graphics) then
- Exit;
-
- bmp := TBitmap.Create;
- bmp.Width := Images.Width;
- bmp.Height := Images.Height;
- bmp.Canvas.Brush.Color := clFuchsia;
- bmp.Canvas.FillRect(Rect(0, 0, bmp.Width, bmp.Height));
- Images.Draw(bmp.Canvas, 0, 0, ImageIndex, Enable);
-
- ms := TMemoryStream.Create;
- bmp.SaveToStream(ms);
- hGlobal := GlobalAlloc(GMEM_MOVEABLE, ms.Size);
- if (hGlobal = 0) then
- begin
- ms.Free;
- raise Exception.Create('Could not allocate memory for image');
- end;
-
- try
- pstm := nil;
-
- // Create IStream* from global memory
- CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
- pstm.Write(ms.Memory, ms.Size,@pcbWrite);
-
- Img := TGPImage.Create(pstm);
-
- GPBmp := TGPBitmap.Create(pstm);
- GPBmp.GetPixel(0, 0, AClr);
- GPBmp.Free;
-
- r := ADVGDIP.GetRed(AClr);
- g := ADVGDIP.GetGreen(AClr);
- b := ADVGDIP.GetBlue(AClr);
-
- ImageAttributes := TGPImageAttributes.Create;
- ImageAttributes.SetColorKey(MakeColor(r, g, b), MakeColor(r, g, b), ColorAdjustTypeDefault);
- graphics.DrawImage(Img, MakeRect(P.X, P.Y, Img.GetWidth, Img.Getheight), // destination rectangle
- 0, 0, // upper-left corner of source rectangle
- Img.GetWidth, // width of source rectangle
- Img.GetHeight, // height of source rectangle
- UnitPixel,
- ImageAttributes);
-
- ImageAttributes.Free;
- Img.Free;
- ms.Free;
- finally
- GlobalFree(hGlobal);
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure DrawGDIPImage(graphics: TGPGraphics; P: TPoint; Pic: TGDIPPicture);
-var
- Img: TGPImage;
- pstm: IStream;
- hGlobal: THandle;
- pcbWrite: Longint;
- ms: TMemoryStream;
- ImageAttributes: TGPImageAttributes;
- r, g, b: byte;
- GPBmp: TGPBitmap;
- Aclr: TGPColor;
-begin
- ms := TMemoryStream.Create;
- pic.SaveToStream(ms);
- hGlobal := GlobalAlloc(GMEM_MOVEABLE, ms.Size);
- if (hGlobal = 0) then
- begin
- ms.Free;
- raise Exception.Create('Could not allocate memory for image');
- end;
-
- try
- pstm := nil;
-
- // Create IStream* from global memory
- CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
- pstm.Write(ms.Memory, ms.Size,@pcbWrite);
-
- Img := TGPImage.Create(pstm);
-
- GPBmp := TGPBitmap.Create(pstm);
- GPBmp.GetPixel(0, 0, AClr);
- GPBmp.Free;
-
- r := ADVGDIP.GetRed(AClr);
- g := ADVGDIP.GetGreen(AClr);
- b := ADVGDIP.GetBlue(AClr);
-
- ImageAttributes := TGPImageAttributes.Create;
- ImageAttributes.SetColorKey(MakeColor(r, g, b), MakeColor(r, g, b), ColorAdjustTypeDefault);
- graphics.DrawImage(Img, MakeRect(P.X, P.Y, Img.GetWidth, Img.Getheight), // destination rectangle
- 0, 0, // upper-left corner of source rectangle
- Img.GetWidth, // width of source rectangle
- Img.GetHeight, // height of source rectangle
- UnitPixel,
- ImageAttributes);
-
- ImageAttributes.Free;
- Img.Free;
- ms.Free;
- finally
- GlobalFree(hGlobal);
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function DrawVistaButton(Canvas: TCanvas; r: TRect; CFU, CTU, CFB, CTB, PC: TColor;
- GradientU, GradientB: TGDIPGradient; Caption:string; WideCaption: widestring; DrawCaption: Boolean; AFont: TFont;
- Images: TImageList; ImageIndex: Integer; EnabledImage: Boolean; Layout: TButtonLayout;
- DropDownButton: Boolean; DrawDwLine: Boolean; Enabled: Boolean; Focus: Boolean; DropDownPos: TDropDownPosition;
- Picture: TGDIPPicture; ForcePicSize: TSize; AntiAlias: TAntiAlias; DrawPic: Boolean; Glyph: TBitmap; ButtonDisplay: TButtonDisplay; Transparent, Hot: boolean;
- ButtonPosition: TButtonPosition; DropDownSplit, DrawBorder, OverlapText, WordWrap, AutoSize, Rounded, DropDir: Boolean; Spacing: integer;
- Trimming: TStringTrimming;Notes: TStringList; NotesFont: TFont;Checked: boolean): TSize;
-var
- graphics : TGPGraphics;
- path: TGPGraphicsPath;
- pthGrBrush: TGPPathGradientBrush;
- linGrBrush: TGPLinearGradientBrush;
- count: Integer;
- w,h,h2,h2d: Integer;
- colors : array[0..0] of TGPColor;
- fontFamily,nfontFamily: TGPFontFamily;
- font,nfont: TGPFont;
- rectf: TGPRectF;
- stringFormat: TGPStringFormat;
- solidBrush,nsolidBrush: TGPSolidBrush;
- x1,y1,x2,y2: single;
- fs,nfs: integer;
- sizerect: TGPRectF;
- noterect: TGPRectF;
- ImgX, ImgY, ImgW, ImgH: Integer;
- BtnR, DwR: TRect;
- BR1,BR2: TRect;
- DR1,DR2: TRect;
- AP: TPoint;
- szRect: TRect;
- tm: TTextMetric;
- ttf: boolean;
- Radius: integer;
- uformat,wwformat: Cardinal;
- tdrect: TRect;
- th, px, py: integer;
- notesrect: TRect;
- ydropd: integer;
-
-begin
- BtnR := R;
-
- if Rounded then
- Radius := 3
- else
- Radius := 0;
-
- if DropDownPos = dpRight then
- begin
- DwR := Rect(BtnR.Right - DropDownSectWidth, BtnR.Top, BtnR.Right, BtnR.Bottom);
- if DropDownButton then
- BtnR.Right := DwR.Left;
- end
- else // DropDownPos = doBottom
- begin
- DwR := Rect(BtnR.Left, BtnR.Bottom - DropDownSectWidth, BtnR.Right, BtnR.Bottom);
- if DropDownButton then
- BtnR.Bottom := DwR.Top;
- end;
-
- if (Notes.Text <> '') then
- Layout := blGlyphLeftAdjusted;
-
- w := r.Right - r.Left;
- h := r.Bottom - r.Top;
-
- h2 := h div 2;
-
- // Create GDI+ canvas
- graphics := TGPGraphics.Create(Canvas.Handle);
-
- if not Transparent then
- begin
-
- if DropDownButton and (DrawDwLine) and DropDownSplit then
- begin
- if DropDownPos = dpRight then
- begin
- DR1 := Rect(r.Right - 12, r.Top + h2 - 1, r.Right, r.Bottom);
- DR2 := Rect(r.Right - 12, r.Top, r.Right, r.Bottom - h2);
- BR1 := Rect(r.Left, r.Top + h2 - 1, r.Right - 12, r.Bottom);
- BR2 := Rect(r.Left, r.Top, r.Right - 12, r.Bottom - h2);
- end
- else
- begin
- DR1 := Rect(r.Left, r.Bottom - 6, r.Right, r.Bottom);
- DR2 := Rect(r.Left, r.Bottom - 12, r.Right, r.Bottom - 6);
-
- DR2 := Rect(r.Left, r.Bottom - 12, r.Right, r.Bottom);
-
- h2d := (r.Bottom - r.Top - 12) div 2;
- BR1 := Rect(r.Left, r.Top + h2d - 1, r.Right, r.Bottom - 12);
- BR2 := Rect(r.Left, r.Top, r.Right, r.Bottom - 12 - h2d);
- end;
-
- if ButtonDisplay = bdDropDown then
- begin
- DrawButtonBackground(Canvas, Graphics, BR1, CTB, CFB, GradientB, False);
- DrawButtonBackground(Canvas, Graphics, BR2, CFU, CTU, GradientU, True);
-
- DrawButtonBackground(Canvas, Graphics, DR2, BrightnessColor(CFU,-10), BrightnessColor(CTU,-10), GradientU, True);
- if (DropDownPos = dpRight) then
- DrawButtonBackground(Canvas, Graphics, DR1, BrightnessColor(CTB,-10), BrightnessColor(CFB,-10), GradientB, False);
- end
- else
- begin
- DrawButtonBackground(Canvas, Graphics, BR1, BrightnessColor(CTB,-10), BrightnessColor(CFB,-10), GradientB, False);
- DrawButtonBackground(Canvas, Graphics, BR2, BrightnessColor(CFU,-10), BrightnessColor(CTU,-10), GradientU, True);
-
- DrawButtonBackground(Canvas, Graphics, DR2, CFU, CTU, ggRadial, True);
- if DropDownPos = dpRight then
- DrawButtonBackground(Canvas, Graphics, DR1, CTB, CFB, GradientB, False);
- end;
- end
- else
- begin
- DrawButtonBackground(Canvas, Graphics, Rect(r.Left, r.Top + h2 - 1, r.Right, r.Bottom), CTB, CFB, GradientB, False);
- DrawButtonBackground(Canvas, Graphics, Rect(r.Left, r.Top, r.Right, r.Bottom - h2), CFU, CTU, GradientU, True);
- end;
- end;
-
- graphics.SetSmoothingMode(SmoothingModeAntiAlias);
-
- if not Transparent and DrawBorder then
- begin
- case ButtonPosition of
- bpStandalone: DrawRoundRect(Graphics, PC, r.Left, r.Top, r.Right - 1, r.Bottom - 1, Radius);
- bpLeft: DrawOpenRoundRectLeft(Graphics, PC, r.Left, r.Top, r.Right - 1, r.Bottom - 1, Radius);
- bpRight: DrawOpenRoundRectRight(Graphics, PC, r.Left, r.Top, r.Right - 1, r.Bottom - 1, Radius, Hot or Checked);
- bpMiddle: DrawOpenRoundRectMiddle(Graphics, PC, r.Left, r.Top, r.Right - 1, r.Bottom - 1, Radius, Hot or Checked);
- end;
- end;
-
- if Focus then // Draw focus line
- begin
- graphics.SetSmoothingMode(SmoothingModeAntiAlias);
- DrawRoundRect(graphics, $E4AD89,r.Left + 1,r.Top + 1, r.Right - 3, r.Bottom - 3, Radius);
- graphics.SetSmoothingMode(SmoothingModeAntiAlias);
- DrawDottedRoundRect(graphics, clGray,r.Left + 2,r.Top + 2, r.Right - 5, r.Bottom - 5, Radius);
- end;
-
- ImgX := 0;
- ImgY := 0;
- ImgH := 0;
- ImgW := 0;
-
- fontFamily := TGPFontFamily.Create(AFont.Name);
-
- if (fontFamily.Status in [FontFamilyNotFound, FontStyleNotFound]) then
- begin
- fontFamily.Free;
- fontFamily := TGPFontFamily.Create('Arial');
- end;
-
- nfontFamily := TGPFontFamily.Create(NotesFont.Name);
-
- if (nfontFamily.Status in [FontFamilyNotFound, FontStyleNotFound]) then
- begin
- nfontFamily.Free;
- nfontFamily := TGPFontFamily.Create('Arial');
- end;
-
-
- fs := 0;
- if (fsBold in AFont.Style) then
- fs := fs + 1;
- if (fsItalic in AFont.Style) then
- fs := fs + 2;
- if (fsUnderline in AFont.Style) then
- fs := fs + 4;
-
- nfs := 0;
- if (fsBold in NotesFont.Style) then
- nfs := nfs + 1;
- if (fsItalic in NotesFont.Style) then
- nfs := nfs + 2;
- if (fsUnderline in NotesFont.Style) then
- nfs := nfs + 4;
-
- if Assigned(Glyph) and not Glyph.Empty and (Glyph.Width > 1) and (Glyph.Height > 1) then
- begin
- ImgW := Glyph.Width;
- ImgH := Glyph.Height;
-
- if (ForcePicSize.CX > 0) and (ForcePicSize.CY > 0) then
- begin
- ImgW := ForcePicSize.CX;
- ImgH := ForcePicSize.CY;
- end;
- end
- else if Assigned(Picture) and not Picture.Empty then
- begin
- Picture.GetImageSizes;
- ImgW := Picture.Width;
- ImgH := Picture.Height;
- if (ForcePicSize.CX > 0) and (ForcePicSize.CY > 0) then
- begin
- ImgW := ForcePicSize.CX;
- ImgH := ForcePicSize.CY;
- end;
- end
- else
- begin
- if (ImageIndex > -1) and Assigned(Images) then
- begin
- ImgW := Images.Width;
- ImgH := Images.Height;
- {end
- else if Assigned(ToolImage) and not (ToolImage.Empty) and (ToolImage.Width > 1) then
- begin
- ImgW := ToolImage.Width;
- ImgH := ToolImage.Height; }
- end;
- end;
-
- if DrawCaption and ((Caption <> '') or (WideCaption <> '')) then
- begin
- if (ImgW > 0) and (Layout in [blGlyphLeft, blGlyphLeftAdjusted, blGlyphRight, blGlyphRightAdjusted])then
- ImgW := ImgW + Spacing;
- if (ImgH > 0) and (Layout in [blGlyphTop, blGlyphTopAdjusted])then
- ImgH := ImgH + Spacing;
- end;
-
- Result.cx := ImgW;
- Result.cy := ImgH;
-
- if (Caption <> '') or (WideCaption <> '') then
- begin
- if pos('\n',caption) > 0 then
- begin
- if (ForcePicSize.cx > 0) and (ForcePicSize.cy > 0) then
- Caption := StringReplace(caption, '\n', ' ', [rfReplaceAll, rfIgnoreCase])
- else
- Caption := StringReplace(caption, '\n', #10#13, [rfReplaceAll, rfIgnoreCase]);
- end;
-
- Canvas.Font.Name := AFont.Name;
-
- ttf := false;
-
- GetTextMetrics(Canvas.Handle, tm);
-
- if ((tm.tmPitchAndFamily AND TMPF_VECTOR) = TMPF_VECTOR) then
- begin
- if not ((tm.tmPitchAndFamily AND TMPF_DEVICE) = TMPF_DEVICE) then
- begin
- ttf := true;
- end
- end;
-
- if Screen.Fonts.IndexOf(AFont.Name) = -1 then
- ttf := false;
-
- font := TGPFont.Create(fontFamily, AFont.Size , fs, UnitPoint);
-
- w := BtnR.Right - BtnR.Left;
- h := BtnR.Bottom - BtnR.Top;
-
- x1 := r.Left;
- y1 := r.Top;
- x2 := w;
- y2 := h;
-
- if AutoSize then
- begin
- x2 := 4096;
- y2 := 4096;
- end;
-
- rectf := MakeRect(x1,y1,x2,y2);
-
- if WordWrap then
- stringFormat := TGPStringFormat.Create(0)
- else
- stringFormat := TGPStringFormat.Create(GDIP_NOWRAP);
-
- if Enabled then
- solidBrush := TGPSolidBrush.Create(ColorToARGB(AFont.Color))
- else
- solidBrush := TGPSolidBrush.Create(ColorToARGB(clGray));
-
- // Center-justify each line of text.
- // stringFormat.SetAlignment(StringAlignmentCenter);
- case Layout of
- blGlyphLeftAdjusted: stringFormat.SetAlignment(StringAlignmentNear);
- blGlyphRightAdjusted: stringFormat.SetAlignment(StringAlignmentFar);
- else stringFormat.SetAlignment(StringAlignmentCenter);
- end;
-
- // Center the block of text (top to bottom) in the rectangle.
-
- case Layout of
- blGlyphTopAdjusted: stringFormat.SetLineAlignment(StringAlignmentNear);
- blGlyphBottomAdjusted: stringFormat.SetLineAlignment(StringAlignmentFar);
- else stringFormat.SetLineAlignment(StringAlignmentCenter);
- end;
-
- stringFormat.SetHotkeyPrefix(HotkeyPrefixShow);
- stringFormat.SetTrimming(Trimming);
-
- case AntiAlias of
- aaClearType:graphics.SetTextRenderingHint(TextRenderingHintClearTypeGridFit);
- aaAntiAlias:graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
- end;
-
- if (AntiAlias = aaNone) or not ttf then
- begin
- Canvas.Font.Assign(AFont);
- szRect.Left := round(rectf.X);
- szRect.Top := round(rectf.Y);
-
- szRect.Right := szRect.Left + 2;
-
- uformat := DT_CALCRECT or DT_LEFT;
-
- if WordWrap then
- begin
- szRect.Right := szRect.Left + 4096;
- uformat := uformat + DT_WORDBREAK
- end
- else
- uformat := uformat + DT_SINGLELINE;
-
- if Caption <> '' then
- szRect.Bottom := DrawText(Canvas.Handle,PChar(Caption),Length(Caption), szrect, uformat)
- else
- szRect.Bottom := DrawTextW(Canvas.Handle,PWideChar(WideCaption),Length(WideCaption), szrect, uformat);
-
- ydropd := (round(rectf.Height) + szRect.Bottom) div 2;
-
- sizeRect.Width := szRect.Right - szRect.Left;
- sizeRect.Height := szRect.Bottom - szRect.Top;
-
- notesRect := Rect(0,0,0,0);
-
- if Notes.Text <> '' then
- begin
- Canvas.Font.Assign(NotesFont);
- notesRect.Left := round(rectf.X);
- notesRect.Top := round(rectf.Y);
- notesRect.Right := notesRect.Left + 2;
- notesRect.Bottom := DrawText(Canvas.Handle,PChar(Notes.Text),Length(Notes.Text), notesRect, DT_CALCRECT or DT_LEFT or DT_WORDBREAK);
-
- noteRect.Width := notesRect.Right - notesRect.Left;
- noteRect.Height := notesRect.Bottom - notesRect.Top;
- end;
-
- case Layout of
- blGlyphLeft:
- begin
- sizeRect.X := (w - (szRect.Right - szRect.Left) - ImgW) div 2;
- sizeRect.Y := szRect.Top;
- Result.cx := ImgW + Spacing + round(sizerect.Width);
- Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height));
- end;
- blGlyphLeftAdjusted:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := szRect.Top;
- Result.cx := ImgW + Spacing + Max(round(sizerect.Width),round(noteRect.Width));
- Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height)+round(noteRect.Height));
- end;
- blGlyphTop:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := (h - (szRect.Bottom - szRect.Top) - ImgH - 2) div 2;
- Result.cx := Max(ImgW + Spacing, Spacing + round(sizerect.Width));
- Result.cy := ImgH + Spacing + round(sizerect.Height);
- end;
- blGlyphTopAdjusted:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := szRect.Top;
- Result.cx := Max(ImgW + Spacing, Spacing + round(sizerect.Width));
- Result.cy := ImgH + Spacing + round(sizerect.Height);
- end;
- blGlyphRight:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := szRect.Top;
- Result.cx := ImgW + Spacing + round(sizerect.Width);
- Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height));
- end;
- blGlyphRightAdjusted:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := szRect.Top;
- Result.cx := ImgW + Spacing + round(sizerect.Width);
- Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height));
- end;
- blGlyphBottom:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := szRect.Top;
- Result.cx := Max(ImgW + Spacing, Spacing + round(sizerect.Width));
- Result.cy := ImgH + Spacing + round(sizerect.Height);
- end;
- blGlyphBottomAdjusted:
- begin
- sizeRect.X := szRect.Left;
- sizeRect.Y := szRect.Top;
- Result.cx := Max(ImgW + Spacing, Spacing + round(sizerect.Width));
- Result.cy := ImgH + Spacing + round(sizerect.Height);
- end;
- end;
- //Result.cx := ImgW + Spacing + round(sizerect.Width);
- //Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height));
- end
- else
- begin
- if Caption <> '' then
- graphics.MeasureString(Caption, Length(Caption), font, rectf, stringFormat, sizeRect)
- else
- graphics.MeasureString(WideCaption, Length(WideCaption), font, rectf, stringFormat, sizeRect);
-
- ydropd := round(sizerect.y + sizerect.height);
-
- noteRect := MakeRect(0,0,0,0);
-
- rectf.Width := rectf.Width - ImgW - Spacing;
-
- if Notes.Text <> '' then
- begin
- nfont := TGPFont.Create(nfontFamily, NotesFont.Size , nfs, UnitPoint);
- graphics.MeasureString(Notes.Text, Length(Notes.Text), nfont, rectf, stringFormat, noteRect);
- nfont.Free;
- end;
-
- case Layout of
- blGlyphLeft, blGlyphLeftAdjusted, blGlyphRight, blGlyphRightAdjusted:
- begin
- Result.cx := ImgW + Spacing + Max(round(sizerect.Width), round(noteRect.Width));
- Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height)+round(noteRect.Height));
- end;
- blGlyphTop, blGlyphTopAdjusted, blGlyphBottom, blGlyphBottomAdjusted:
- begin
- Result.cx := Max(ImgW + Spacing, Spacing + round(sizerect.Width));
- Result.cy := ImgH + Spacing + round(sizerect.Height);
- end;
- end;
- end;
-
- if not AutoSize then
- begin
- if not WordWrap then
- begin
- x2 := w;
- y2 := h;
- rectf := MakeRect(x1,y1,x2,y2);
- end;
-
-// if (ImgW > 0) then
- begin
- case Layout of
- blGlyphLeft:
- begin
- if (AntiAlias = aaNone) or not ttf then
- begin
- x1 := sizeRect.X + ImgW;
- x2 := w - 2 - ImgW;
- ImgX := round(sizeRect.X);
- end
- else
- begin
- x1 := r.Left + 2 + ImgW;
- x2 := w - 2 - ImgW;
- ImgX := round(sizerect.X - ImgW div 2);
- end;
- if ImgX < 2 then ImgX := 2;
- ImgY := r.Top + Max(0, (h - ImgH) div 2);
- end;
- blGlyphLeftAdjusted:
- begin
- x1 := r.Left + 2 + ImgW;
- x2 := w - 2 - ImgW;
-
- ImgX := round(sizerect.X - ImgW div 2);
- if ImgX < 2 then ImgX := 2;
- ImgY := r.Top + Max(0, (h - ImgH) div 2);
- end;
- blGlyphTop:
- begin
- if (AntiAlias = aaNone) or not ttf then
- begin
- y1 := r.Top + ImgH;
- // y1 := sizeRect.Y + ImgH;
- y2 := h - 2 - ImgH;
-
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
-// ImgY := round(sizeRect.Y);
- ImgY := round(y2 - sizerect.Height);
- ImgY := Max(0, ImgY div 2);
- ImgY := round(y1) - ImgH + ImgY - 4;
- end
- else
- begin
- y1 := r.Top + ImgH;
- y2 := h - 2 - ImgH;
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
- ImgY := round(y2 - sizerect.Height);
- ImgY := Max(0, ImgY div 2);
- ImgY := round(y1) - ImgH + ImgY;
- end;
- if ImgY < 2 then ImgY := 2;
- end;
- blGlyphTopAdjusted:
- begin
- y1 := r.Top{ + 2} + ImgH;
- y2 := h - 2 - ImgH;
-
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
- if Layout = blGlyphTopAdjusted then
- ImgY := 0 //force to top margin
- else
- ImgY := round(y2 - sizerect.Height);
- ImgY := Max(0, ImgY div 2);
- ImgY := round(y1) - ImgH + ImgY; //round(sizerect.Height) - ImgY - 4;
- if ImgY < 2 then ImgY := 2;
- end;
- blGlyphRight, blGlyphRightAdjusted:
- begin
- x1 := 2;
- x2 := w - 4 - ImgW;
- if Layout = blGlyphRightAdjusted then
- ImgX := w - ImgW - 2
- else
- begin
-
- ImgX := round(X2 - sizerect.width);
- ImgX := Max(0, ImgX div 2);
- ImgX := ImgX + round(sizerect.width) + 4;
- if ImgX > (w - ImgW) then
- ImgX := w - ImgW - 2;
- end;
- ImgY := r.Top + Max(0, (h - ImgH) div 2);
- ImgX := ImgX + spacing;
- end;
- blGlyphBottom:
- begin
- if (AntiAlias = aaNone) or not ttf then
- begin
- y1 := 2;
- y2 := h - 2 - ImgH;
-
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
- ImgY := round(y2 - sizerect.Height);
- ImgY := Max(0, ImgY div 2);
- ImgY := round(sizerect.Height + 5) + ImgY;
- if ImgY > (h - ImgH) then ImgY := h - ImgH - 2;
- end
- else
- begin
- y1 := 2;
- y2 := h - 2 - ImgH;
-
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
- ImgY := round(y2 - sizerect.Height);
- ImgY := Max(0, ImgY div 2);
- ImgY := round(sizerect.Height + 2) + ImgY;
- if ImgY > (h - ImgH) then ImgY := h - ImgH - 2;
- end;
- end;
- blGlyphBottomAdjusted:
- begin
- if (AntiAlias = aaNone) or not ttf then
- begin
- y1 := 2;
- y2 := h - 4 - ImgH;
-
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
- ImgY := (h - ImgH - 2);
- end
- else
- begin
- y1 := 2;
- y2 := h - 2 - ImgH;
-
- ImgX := r.Left + Max(0, (w - ImgW) div 2);
- if Layout = blGlyphBottomAdjusted then
- ImgY := h; //force to bottom margin
-
- ImgY := Max(0, ImgY div 2);
- ImgY := round(sizerect.Height + 2) + ImgY;
- if ImgY > (h - ImgH) then ImgY := h - ImgH - 2;
- end;
- end;
- end;
- end;
-
- if OverlapText then
- rectf := MakeRect(r.Left, r.Top, r.Right, r.Bottom)
- else
- rectf := MakeRect(x1, y1, x2, y2);
-
- if DrawPic and OverlapText then
- begin
- if Assigned(Glyph) and not Glyph.Empty and (Glyph.Width > 1) and (Glyph.Height > 1) then
- Canvas.Draw(ImgX, ImgY, Glyph);
- end;
-
- if DrawCaption then
- begin
- if (AntiAlias = aaNone) or not ttf then
- begin
- szRect.Left := round(rectf.X);
- szRect.Top := round(rectf.Y);
- szRect.Right := szRect.Left + round(rectf.Width);
- szRect.Bottom := szRect.Top + round(rectf.Height);
-
- Canvas.Brush.Style := bsClear;
- if WordWrap then
- wwformat := DT_WORDBREAK
- else
- wwformat := DT_SINGLELINE;
-
- uformat := DT_VCENTER or wwformat;
-
- case Layout of
- blGlyphLeft:
- begin
- uformat := DT_VCENTER or wwformat or DT_LEFT;
- szrect.Left := szrect.Left;
- end;
- blGlyphLeftAdjusted:
- begin
- uformat := DT_VCENTER or wwformat or DT_LEFT;
- szrect.Left := szrect.Left + 2;
-
- if Notes.Text <> '' then
- begin
- uformat := uformat AND NOT DT_VCENTER;
- szrect.Top := ((szRect.Bottom - szRect.Top) - round(sizeRect.Height) - round(noteRect.Height)) div 2;
- end;
-
- end;
- blGlyphTop:
- begin
- uformat := DT_TOP or wwformat or DT_CENTER or DT_VCENTER;
- end;
- blGlyphTopAdjusted: uformat := DT_TOP or wwformat or DT_CENTER;
- blGlyphRight: uformat := DT_VCENTER or wwformat or DT_CENTER;
- blGlyphRightAdjusted: uformat := DT_VCENTER or wwformat or DT_RIGHT;
- blGlyphBottom: uformat := DT_VCENTER or wwformat or DT_CENTER;
- blGlyphBottomAdjusted: uformat := DT_BOTTOM or wwformat or DT_CENTER;
- end;
-
- tdrect := szrect;
-
- Canvas.Font.Assign(AFont);
-
- if not Enabled then
- Canvas.Font.Color := clGray;
-
- if WordWrap then
- begin
- if Caption <> '' then
- th := DrawText(Canvas.Handle,PChar(Caption),Length(Caption), szrect, uformat or DT_CALCRECT)
- else
- th := DrawTextW(Canvas.Handle,PWideChar(WideCaption),Length(WideCaption), szrect, uformat or DT_CALCRECT);
-
- case Layout of
- blGlyphTopAdjusted:
- begin
- // do nothing
- end;
- blGlyphTop:
- begin
- tdrect.Top := ImgY + ImgH;
- tdrect.Top := tdrect.Top + (tdrect.Bottom - tdrect.Top - th) div 2;
- end;
- blGlyphBottomAdjusted:
- begin
- tdrect.Top := tdrect.Bottom - th;
- end;
- else
- begin
- tdrect.Top := (tdrect.Bottom - tdrect.Top - th) div 2;
- end;
- end;
- end;
-
- if Caption <> '' then
- DrawText(Canvas.Handle,PChar(Caption),Length(Caption), tdrect, uformat)
- else
- DrawTextW(Canvas.Handle,PWideChar(WideCaption),Length(WideCaption), tdrect, uformat);
-
- if (Notes.Text <> '') then
- begin
- tdRect.Top := tdRect.Top + round(sizeRect.Height);
- tdRect.Bottom := tdRect.Top + round(noteRect.Height);
- Canvas.Font.Assign(NotesFont);
- DrawText(Canvas.Handle,PChar(Notes.Text),Length(Notes.Text), tdrect, uformat);
- end;
- end
- else
- begin
- if (Notes.Text <> '') then
- begin
- stringFormat.SetLineAlignment(StringAlignmentNear);
- rectf.Y := rectf.Y + ((rectf.Height) - round(sizeRect.Height) - round(noteRect.Height)) / 2;
- end;
-
- if (Caption <> '') then
- graphics.DrawString(Caption, Length(Caption), font, rectf, stringFormat, solidBrush)
- else
- graphics.DrawString(WideCaption, Length(WideCaption), font, rectf, stringFormat, solidBrush);
-
- if (Notes.Text <> '') then
- begin
- rectf.Y := rectf.Y + round(sizeRect.Height);
- nfont := TGPFont.Create(nfontFamily, NotesFont.Size , nfs, UnitPoint);
- nsolidBrush := TGPSolidBrush.Create(ColorToARGB(NotesFont.Color));
- graphics.DrawString(Notes.Text, Length(Notes.Text), nfont, rectf, stringFormat, nsolidBrush);
- nsolidBrush.Free;
- nfont.Free;
- end
- end;
- end;
- end;
-
- stringformat.Free;
- solidBrush.Free;
- font.Free;
- end;
-
-
- fontFamily.Free;
- nfontFamily.Free;
-
- if not AutoSize then
- begin
- if DropDownButton then
- begin
- if DropDownPos = dpRight then
- w := w - 8
- else
- h := h - 8;
- end;
-
- if DrawPic and not OverlapText then
- begin
- if Assigned(Glyph) and not Glyph.Empty and (Glyph.Width > 1) and (Glyph.Height > 1) then
- begin
- if (ForcePicSize.CX > 0) and (ForcePicSize.CY > 0) then
- begin
- Glyph.Transparent := True;
- if (Caption = '') and (WideCaption = '') then
- begin
- px := r.Left + Max(0, (w - ImgW) div 2);
- py := r.Top + Max(0, (h - ImgH) div 2);
- Canvas.StretchDraw(Rect(px, py, px + ForcePicSize.CX, py + ForcePicSize.CY), Glyph);
- end
- else
- Canvas.StretchDraw(Rect(ImgX, ImgY, ImgX + ForcePicSize.CX, ImgY + ForcePicSize.CY), Glyph);
- end
- else
- begin
- if (Caption = '') and (WideCaption = '') then
- Canvas.Draw(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), Glyph)
- else
- Canvas.Draw(ImgX, ImgY, Glyph);
- end;
- end
- else
- if Assigned(Picture) and not Picture.Empty then
- begin
- if (ForcePicSize.CX > 0) and (ForcePicSize.CY > 0) then
- begin
- if (Caption = '') and (WideCaption = '') then
- begin
- px := r.Left + Max(0, (w - ImgW) div 2);
- py := r.Top + Max(0, (h - ImgH) div 2);
- //Canvas.StretchDraw(Rect(px, py, px + ForcePicSize.CX, py + ForcePicSize.CY), Picture);
- DrawStretchPicture(graphics, Canvas, Rect(px, py, px + ForcePicSize.CX, py + ForcePicSize.CY), Picture);
- end
- else
- begin
- //Canvas.StretchDraw(Rect(ImgX, ImgY, ImgX + ForcePicSize.CX, ImgY + ForcePicSize.CY), Picture);
- DrawStretchPicture(graphics, Canvas, Rect(ImgX, ImgY, ImgX + ForcePicSize.CX, ImgY + ForcePicSize.CY), Picture);
- end;
- end
- else
- begin
- if (Caption = '') and (WideCaption = '') then
- begin
- //Canvas.Draw(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), Picture)
- DrawGDIPImage(graphics, Point(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2)), Picture);
- //DrawStretchPicture(graphics, Canvas, Rect(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), Picture.Width, Picture.Height), Picture);
- end
- else
- //Canvas.Draw(ImgX, ImgY, Picture);
- DrawGDIPImage(graphics, Point(ImgX, ImgY), Picture);
- end;
- end
- else
- if (ImageIndex <> -1) and Assigned(Images) then
- begin
- if (Caption = '') and (WideCaption = '') then
- begin
- //Images.Draw(Canvas, r.Left + Max(0, (w - Images.Width) div 2), r.Top + Max(0, (h - Images.Height) div 2), ImageIndex, EnabledImage)
- DrawGDIPImageFromImageList(graphics, Point(r.Left + Max(0, (w - Images.Width) div 2), r.Top + Max(0, (h - Images.Height) div 2)), Images, ImageIndex, EnabledImage);
- end
- else
- begin
- //Images.Draw(Canvas, ImgX, ImgY, ImageIndex, EnabledImage);
- DrawGDIPImageFromImageList(graphics, Point(ImgX, ImgY), Images, ImageIndex, EnabledImage)
- end;
- {end
- else if Assigned(ToolImage) and not (ToolImage.Empty) and (ToolImage.Width > 1) then
- begin
- if Caption = '' then
- Canvas.Draw(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), ToolImage)
- else
- Canvas.Draw(ImgX, ImgY, ToolImage); }
- end;
- end;
-
- Canvas.Brush.Style := bsClear;
-
- if DropDownButton then
- begin
- if DrawDwLine and DropDownSplit then
- begin
- Canvas.Pen.Color := ColorToRGB(PC);
- if (DropDownPos = dpRight) then
- begin
- Canvas.MoveTo(DwR.Left, DwR.Top);
- Canvas.LineTo(DwR.Left, DwR.Bottom);
- end
- else
- begin
- Canvas.MoveTo(DwR.Left, DwR.Top);
- Canvas.LineTo(DwR.Right, DwR.Top);
- end;
- end;
-
- AP.X := DwR.Left + ((DwR.Right - DwR.Left - 5) div 2);
-
- if (DropDownPos = dpBottom) or ((Caption = '') and (WideCaption = '')) then
- AP.Y := DwR.Top + ((DwR.Bottom - DwR.Top - 3) div 2) + 1
- else
- AP.Y := yDropD - 8;
-
- if not Enabled then
- DrawArrow(Canvas, AP, clGray, clWhite, DropDir)
- else
- DrawArrow(Canvas, AP, clBlack, clWhite, DropDir);
- end;
- end;
-
- graphics.Free;
-end;
-
-//------------------------------------------------------------------------------
-
-{TWinCtrl}
-
-procedure TWinCtrl.PaintCtrls(DC: HDC; First: TControl);
-begin
- PaintControls(DC, First);
-end;
-
-//------------------------------------------------------------------------------
-
-{ TAdvGlowButton }
-
-
-//------------------------------------------------------------------------------
-
-
-procedure TAdvCustomGlowButton.CMMouseEnter(var Msg: TMessage);
-begin
- inherited;
-
- if Assigned(FOnMouseEnter) then
- FOnMouseEnter(Self);
-
- if (csDesigning in ComponentState) then
- Exit;
-
- if FMouseEnter then
- Exit;
-
- FHot := true;
-
- if FLeftDown then
- FDown := true;
-
- if not Assigned(FTimer) then
- begin
- FTimer := TTimer.Create(self);
- FTimer.OnTimer := TimerProc;
- FTimer.Interval := GlowSpeed;
- FTimer.Enabled := true;
- end;
-
- if not FDown and (GlowState <> gsPush) then
- begin
- FTimeInc := 20;
- GlowState := gsHover;
- end;
- Invalidate;
-
- FMouseInControl := true;
- FMouseEnter := true;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.CMMouseLeave(var Msg: TMessage);
-begin
- inherited;
-
- if Assigned(FOnMouseLeave) then
- FOnMouseLeave(Self);
-
- if (csDesigning in ComponentState) then
- Exit;
-
- if not FMouseEnter then
- Exit;
-
- FMouseEnter := false;
- FMouseInControl := false;
-
- FHot := false;
- FInButton := false;
-
-// Repaint;
-
- // down process busy
- if FDown and FMouseDown then
- begin
- FDown := False;
- FTimeInc := -20;
- GlowState := gsHover;
- Invalidate;
- FLeftDown := true;
- end
- else
- //if not (Style = bsCheck) then
- begin
- FDown := false;
- FStepHover := 100;
- FTimeInc := -20;
- GlowState := gsHover;
- Invalidate;
- end;
-
- if not Assigned(FTimer) then
- begin
- FTimer := TTimer.Create(self);
- FTimer.OnTimer := TimerProc;
- FTimer.Interval := GlowSpeed;
- FTimer.Enabled := true;
- end;
-
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.CMTextChanged(var Message: TMessage);
-begin
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.CNCommand(var Message: TWMCommand);
-begin
- if Message.NotifyCode = BN_CLICKED then
- begin
- Click;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-constructor TAdvCustomGlowButton.Create(AOwner: TComponent);
-begin
- inherited;
- FTimer := nil;
- FImageIndex := -1;
- DoubleBuffered := true;
- FGroupIndex := 0;
- FState := absUp;
- FStyle := bsButton;
- FTransparent := False;
- FLayout := blGlyphLeft;
- FDropDownButton := False;
- FDropDownPosition := dpRight;
- FDropDownDirection := ddDown;
- FDropDownSplit := true;
- FShowCaption := true;
- FFocusType := ftBorder;
- FShortCutHint := nil;
- FShortCutHintPos := shpTop;
- FShowDisabled := true;
- FOverlappedText := false;
- FSpacing := 2;
- FWordWrap := true;
- FFirstPaint := true;
- FMarginVert := 1;
- FMarginHorz := 1;
- FRounded := true;
- FInitRepeatPause := 400;
- FRepeatPause := 100;
- FRepeatClick := false;
-
- FIPicture := TGDIPPicture.Create;
- FIPicture.OnChange := PictureChanged;
-
- FIDisabledPicture := TGDIPPicture.Create;
- FIDisabledPicture.OnChange := PictureChanged;
- FIHotPicture := TGDIPPicture.Create;
-
- ParentFont := true;
- FAppearance := TGlowButtonAppearance.Create;
- FAppearance.OnChange := OnAppearanceChanged;
- FInternalImages := nil;
- FAntiAlias := aaClearType;
- FBorderStyle := bsSingle;
-
- FOfficeHint := TAdvHintInfo.Create;
-
- Width := 100;
- Height := 41;
-
- FDefaultPicDrawing := True;
- FDefaultCaptionDrawing := True;
- FTrimming := StringTrimmingNone;
-
- FCommandID := -1;
-
- FButtonSizeState := bsLarge;
- FMaxButtonSizeState := bsLarge;
- FMinButtonSizeState := bsGlyph;
- FOldLayout := Layout;
- FOldDropDownPosition := DropDownPosition;
-
- FNotes := TStringList.Create;
- FNotesFont := TFont.Create;
- FNotesFont.Name := 'Tahoma';
- FNotesFont.Size := 8;
-end;
-
-
-procedure TAdvCustomGlowButton.CreateParams(var Params: TCreateParams);
-begin
- inherited;
-// if FTransparent then
-// Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
-end;
-
-procedure TAdvCustomGlowButton.CreateWnd;
-begin
- inherited;
- FActive := FDefault;
- FParentForm := GetParentForm(Self);
-end;
-
-//------------------------------------------------------------------------------
-
-destructor TAdvCustomGlowButton.Destroy;
-begin
- if Assigned(FShortCutHint) then
- FShortCutHint.Free;
- FOfficeHint.Free;
- FAppearance.Free;
- FIPicture.Free;
- FIDisabledPicture.Free;
- FIHotPicture.Free;
- FNotes.Free;
- FNotesFont.Free;
- inherited;
-end;
-
-procedure TAdvCustomGlowButton.DoEnter;
-begin
- inherited;
- Invalidate;
- FHasFocus := true;
-end;
-
-procedure TAdvCustomGlowButton.DoExit;
-begin
- inherited;
- FDown := false;
- FState := absUp;
- FHasFocus := false;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.ShowShortCutHint;
-var
- pt: TPoint;
- SCHintPos: TShortCutHintPos;
- OffsetX: Integer;
-begin
- if not Assigned(FShortCutHint) then
- begin
- FShortCutHint := TShortCutHintWindow.Create(Self);
- FShortCutHint.Parent := Self;
- FShortCutHint.Visible := False;
- FShortCutHint.Color := clWhite;
- FShortCutHint.ColorTo := Appearance.Color;
- end;
-
- FShortCutHint.Caption := FShortCutHintText;
-
- pt := ClientToScreen(Point(0,0));
-
- OffsetX := 6;
- SCHintPos := ShortCutHintPos;
-
- if Assigned(FOnGetShortCutHintPos) then
- FOnGetShortCutHintPos(Self, ButtonSizeState, SCHintPos);
-
- if (SCHintPos = shpAuto) then
- SCHintPos := shpTop;
-
- case SCHintPos of
- shpLeft:
- begin
- //FShortCutHint.Left := pt.X - (FShortCutHint.Width div 2);
- FShortCutHint.Left := pt.X + OffsetX;
- FShortCutHint.Top := pt.Y + (self.Height - FShortCutHint.Height) div 2;
- end;
- shpTop:
- begin
- FShortCutHint.Left := pt.X + (self.Width - FShortCutHint.Width) div 2;
- FShortCutHint.Top := pt.Y - (FShortCutHint.Height div 2);
- end;
- shpRight:
- begin
- FShortCutHint.Left := pt.X + self.Width - (FShortCutHint.Width div 2);
- FShortCutHint.Top := pt.Y + (self.Height - FShortCutHint.Height) div 2;
- end;
- shpBottom:
- begin
- FShortCutHint.Left := pt.X + (self.Width - FShortCutHint.Width) div 2;
- FShortCutHint.Top := pt.Y + self.Height - (FShortCutHint.Height div 2);
- end;
- shpCenter:
- begin
- FShortCutHint.Left := pt.X + (self.Width - FShortCutHint.Width) div 2;
- FShortCutHint.Top := pt.Y + (self.Height - FShortCutHint.Height) div 2;
- end;
- shpTopLeft:
- begin
- FShortCutHint.Left := pt.X + OffsetX;
- FShortCutHint.Top := pt.Y - (FShortCutHint.Height div 2);
- end;
- shpTopRight:
- begin
- FShortCutHint.Left := pt.X + self.Width - FShortCutHint.Width + 1;
- FShortCutHint.Top := pt.Y - (FShortCutHint.Height div 2);
- end;
- shpAboveTop:
- begin
- FShortCutHint.Left := pt.X + (self.Width - FShortCutHint.Width) div 2;
- FShortCutHint.Top := pt.Y - FShortCutHint.Height;
- end;
- shpAboveTopLeft:
- begin
- FShortCutHint.Left := pt.X + OffsetX;
- FShortCutHint.Top := pt.Y - FShortCutHint.Height;
- end;
- shpAboveTopRight:
- begin
- FShortCutHint.Left := pt.X + self.Width - FShortCutHint.Width + 1;
- FShortCutHint.Top := pt.Y - FShortCutHint.Height;
- end;
- shpBottomLeft:
- begin
- FShortCutHint.Left := pt.X + OffsetX;
- FShortCutHint.Top := pt.Y + self.Height - (FShortCutHint.Height div 2);
- end;
- shpBottomRight:
- begin
- FShortCutHint.Left := pt.X + self.Width - FShortCutHint.Width + 1;
- FShortCutHint.Top := pt.Y + self.Height - (FShortCutHint.Height div 2);
- end;
- shpBelowBottom:
- begin
- FShortCutHint.Left := pt.X + (self.Width - FShortCutHint.Width) div 2;
- FShortCutHint.Top := pt.Y + self.Height;
- end;
- shpBelowBottomLeft:
- begin
- FShortCutHint.Left := pt.X + OffsetX;
- FShortCutHint.Top := pt.Y + self.Height
- end;
- shpBelowBottomRight:
- begin
- FShortCutHint.Left := pt.X + self.Width - FShortCutHint.Width + 1;
- FShortCutHint.Top := pt.Y + self.Height
- end;
- shpBelowBottomCenter:
- begin
- FShortCutHint.Left := pt.X + (self.Width - FShortCutHint.Width) div 2;
- FShortCutHint.Top := pt.Y + self.Height
- end;
- end;
-
- FShortCutHint.Visible := true;
-end;
-
-procedure TAdvCustomGlowButton.HideShortCutHint;
-begin
- if Assigned(FShortCutHint) then
- begin
- FShortCutHint.Visible := false;
- //FShortCutHint.Free;
- //FShortCutHint := nil;
- end;
-end;
-
-function TAdvCustomGlowButton.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 TAdvCustomGlowButton.GetVersionNr: Integer;
-begin
- Result := MakeLong(MakeWord(BLD_VER, REL_VER), MakeWord(MIN_VER, MAJ_VER));
-end;
-
-procedure TAdvCustomGlowButton.KeyDown(var Key: Word; Shift: TShiftState);
-begin
- inherited;
- if (Key in [VK_SPACE, VK_RETURN]) then
- begin
- FDown := True;
- FState := absDown;
- Repaint;
- end;
-
- if (Key = VK_F4) then
- DoDropDown;
-
- if Assigned(FOnInternalKeyDown) then
- FOnInternalKeyDown(Self, Key, Shift);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.WMGetDlgCode(var Message: TMessage);
-begin
- if Assigned(FOnInternalKeyDown) then
- Message.Result := DLGC_WANTARROWS
- else
- inherited;
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.KeyPress(var Key: Char);
-var
- Form: TCustomForm;
-begin
- inherited;
-
- if (Key = #32) or (Key = #13) then
- begin
- Form := GetParentForm(Self);
- if Form <> nil then
- Form.ModalResult := ModalResult;
-
- if Assigned(OnClick) then
- OnClick(Self);
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.KeyUp(var Key: Word; Shift: TShiftState);
-begin
- inherited;
- FDown := False;
- FState := absUp;
- Repaint;
-end;
-
-//------------------------------------------------------------------------------
-
-{$IFDEF DELPHI6_LVL}
-function TAdvCustomGlowButton.ActionHasImages: boolean;
-begin
- Result := false;
-
- {$IFDEF DELPHI2006_LVL}
- if not self.StaticActionImageIndex then
- Result := true
- else
- {$ENDIF}
- if Assigned(Action) then
- begin
- if (Action.Owner is TActionList) then
- Result := Assigned((Action.Owner as TActionList).Images);
- end;
-end;
-{$ENDIF}
-
-procedure TAdvCustomGlowButton.Assign(Source: TPersistent);
-begin
- if (Source is TAdvCustomGlowButton) then
- begin
- Align := (Source as TAdvCustomGlowButton).Align;
- Action := (Source as TAdvCustomGlowButton).Action;
- Anchors := (Source as TAdvCustomGlowButton).Anchors;
- AntiAlias := (Source as TAdvCustomGlowButton).AntiAlias;
- AutoSize := (Source as TAdvCustomGlowButton).AutoSize;
- BorderStyle := (Source as TAdvCustomGlowButton).BorderStyle;
- Cancel := (Source as TAdvCustomGlowButton).Cancel;
- Caption := (Source as TAdvCustomGlowButton).Caption;
- Constraints := (Source as TAdvCustomGlowButton).Constraints;
- Default := (Source as TAdvCustomGlowButton).Default;
- Font.Assign((Source as TAdvCustomGlowButton).Font);
- ImageIndex := (Source as TAdvCustomGlowButton).ImageIndex;
- Images.Assign((Source as TAdvCustomGlowButton).Images);
- DisabledImages.Assign((Source as TAdvCustomGlowButton).DisabledImages);
- DisabledPicture.Assign((Source as TAdvCustomGlowButton).DisabledPicture);
- DragMode := (Source as TAdvCustomGlowButton).DragMode;
- DragKind := (Source as TAdvCustomGlowButton).DragKind;
- FocusType := (Source as TAdvCustomGlowButton).FocusType;
- HotImages.Assign((Source as TAdvCustomGlowButton).HotImages);
- HotPicture.Assign((Source as TAdvCustomGlowButton).HotPicture);
- MarginVert := (Source as TAdvCustomGlowButton).MarginVert;
- MarginHorz := (Source as TAdvCustomGlowButton).MarginHorz;
- ModalResult := (Source as TAdvCustomGlowButton).ModalResult;
- Notes.Assign((Source as TAdvCustomGlowButton).Notes);
- NotesFont.Assign((Source as TAdvCustomGlowButton).NotesFont);
- OfficeHint.Assign((Source as TAdvCustomGlowButton).OfficeHint);
- ParentFont := (Source as TAdvCustomGlowButton).ParentFont;;
- Picture.Assign((Source as TAdvCustomGlowButton).Picture);
- PopupMenu := (Source as TAdvCustomGlowButton).PopupMenu;
- Position := (Source as TAdvCustomGlowButton).Position;
- InitRepeatPause := (Source as TAdvCustomGlowButton).InitRepeatPause;
- RepeatPause := (Source as TAdvCustomGlowButton).RepeatPause;
- RepeatClick := (Source as TAdvCustomGlowButton).RepeatClick;
- Rounded := (Source as TAdvCustomGlowButton).Rounded;
- ShortCutHint := (Source as TAdvCustomGlowButton).ShortCutHint;
- ShortCutHintPos := (Source as TAdvCustomGlowButton).ShortCutHintPos;
- ShowCaption := (Source as TAdvCustomGlowButton).ShowCaption;
- ShowDisabled := (Source as TAdvCustomGlowButton).ShowDisabled;
- Spacing := (Source as TAdvCustomGlowButton).Spacing;
- Transparent := (Source as TAdvCustomGlowButton).Transparent;
- Trimming := (Source as TAdvCustomGlowButton).Trimming;
- Version := (Source as TAdvCustomGlowButton).Version;
- WordWrap := (Source as TAdvCustomGlowButton).WordWrap;
- ShowHint := (Source as TAdvCustomGlowButton).ShowHint;
- ParentShowHint := (Source as TAdvCustomGlowButton).ParentShowHint;
- TabOrder := (Source as TAdvCustomGlowButton).TabOrder;
- TabStop := (Source as TAdvCustomGlowButton).TabStop;
- Visible := (Source as TAdvCustomGlowButton).Visible;
- end;
-
-end;
-
-procedure TAdvCustomGlowButton.Click;
-var
- Form: TCustomForm;
-begin
- Form := GetParentForm(Self);
- if Form <> nil then
- Form.ModalResult := ModalResult;
-
- if Assigned(FOnInternalClick) then
- FOnInternalClick(Self);
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.Loaded;
-begin
- inherited;
- if (Down <> FInitialDown) then
- Down := FInitialDown;
- FIsVista := IsVista;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.DoDropDown;
-var
- pt: TPoint;
-begin
- if IsMenuButton or Assigned(FDropDownMenu) then
- begin
- {State := absDropDown;
- Invalidate;
- CheckMenuDropdown; }
-
- if Assigned(FDropDownMenu) then
- begin
- //FDown := false;
- //FHot := false;
- FState := absDown;
- PopupBtnDown;
- Invalidate;
-
- if DropDownDirection = ddDown then
- pt := Point(Left, Top + Height)
- else
- pt := Point(Left + Width, Top);
-
- pt := Parent.ClientToScreen(pt);
- FDropDownMenu.Popup(pt.X,pt.Y);
-
- FState := absUp;
- Repaint;
- end;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGlowButton.IsFontStored: Boolean;
-begin
- Result := not ParentFont;
-end;
-
-function TAdvCustomGlowButton.IsMenuButton: Boolean;
-begin
- Result := False;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.TimerExpired(Sender: TObject);
-begin
- FRepeatTimer.Interval := RepeatPause;
- if (FDown) and MouseCapture then
- begin
- try
- Click;
- except
- FRepeatTimer.Enabled := False;
- raise;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.MouseUp(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-begin
- inherited MouseUp(Button, Shift, X, Y);
- if FRepeatTimer <> nil then
- FRepeatTimer.Enabled := False;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
- Y: Integer);
-var
- pt:TPoint;
- InBottomDrop,InRightDrop: boolean;
- InSepBtn: boolean;
-
-begin
- inherited;
-
- if Button <> mbLeft then
- Exit;
-
- if FRepeatClick then
- begin
- if FRepeatTimer = nil then
- FRepeatTimer := TTimer.Create(Self);
-
- FRepeatTimer.OnTimer := TimerExpired;
- FRepeatTimer.Interval := InitRepeatPause;
- FRepeatTimer.Enabled := True;
- end;
-
-
- FDown := true;
- FMouseDown := true;
-
- if TabStop then
- SetFocus;
-
- if not Assigned(FTimer) then
- begin
- FTimer := TTimer.Create(self);
- FTimer.OnTimer := TimerProc;
- FTimer.Interval := GlowSpeed;
- FTimer.Enabled := true;
- end;
-
- //FStepPush := 0;
- FTimeInc := +20;
- GlowState := gsPush;
-
- if not DropDownButton and IsMenuButton and false then
- begin
- Invalidate;
- DoDropDown;
- end;
-
- InBottomDrop := (DropDownPosition = dpRight) and (X > (Width - DropDownSectWidth));
- InRightDrop := (DropDownPosition = dpBottom) and (Y > (Height - DropDownSectWidth));
-
- InSepBtn := (InBottomDrop or InRightDrop);
-
- if (not FDropDownButton and IsMenuButton) or
- (FDropDownButton and InSepBtn and DropDownSplit) or
- (FDropDownButton and not DropDownSplit and (not ((Style = bsCheck) or (GroupIndex > 0))))
- then
- begin
- // FState := absUp;
- FMouseInControl := False;
- // FMouseDownInControl := False;
- PopupBtnDown;
-
- if Assigned(FDropDownMenu) then
- begin
- FDown := false;
- FHot := false;
- SetDroppedDown(True);
- FMouseEnter := true;
- //FMenuSel := true;
- Repaint;
-
- if DropDownDirection = ddDown then
- pt := Point(Left, Top + Height)
- else
- pt := Point(Left + Width, Top);
-
- pt := Parent.ClientToScreen(pt);
- //if Assigned(AdvToolBar) then
- //FDropDownMenu.MenuStyler := AdvToolBar.FCurrentToolBarStyler.CurrentAdvMenuStyler;
- FDropDownMenu.Popup(pt.X,pt.Y);
- SetDroppedDown(False);
- //FMenuSel := false;
-
- GetCursorPos(pt);
- pt := ScreenToClient(pt);
- if not PtInRect(ClientRect, pt) then
- begin
- FMouseEnter := false;
- FMouseInControl := false;
- FHot := false;
- FInButton := false;
- end;
- Repaint;
- end;
-
- Invalidate;
- end
- else
- begin
- if (Style = bsCheck) then
- begin
- SetDown(not FDownChecked);
- end;
-
- if not FDownChecked then
- begin
- FState := absDown;
- Invalidate;
- end;
-
- if (Style = bsCheck) then
- begin
- FState := absDown;
- Repaint;
- end;
-
- FDragging := True;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.InternalClick;
-begin
- if (not FDropDownButton and IsMenuButton) or (FDropDownButton and not ((Style = bsCheck) or (GroupIndex > 0)) and
- (not DropDownSplit)) then
- begin
- if Assigned(FDropDownMenu) then
- begin
- //PostMessage(Handle, WM_LBUTTONDOWN,0,0);
- //PostMessage(Handle, WM_LBUTTONUP,0,0);
- DoDropDown;
- end
- else
- Click;
- end
- else
- begin
- if Style = bsCheck then
- begin
- SetDown(not FDownChecked);
- end;
-
- if not FDownChecked then
- begin
- FState := absDown;
- Invalidate;
- end;
-
- if (Style = bsCheck) then
- begin
- FState := absDown;
- Repaint;
- end;
-
- Click;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.WMLDblClk(var Msg: TWMLButtonDblClk);
-begin
- inherited;
-end;
-
-procedure TAdvCustomGlowButton.WMPaint(var Msg: TWMPaint);
-var
- DC, MemDC: HDC;
- MemBitmap, OldBitmap: HBITMAP;
- PS: TPaintStruct;
-begin
- if not FDoubleBuffered or (Msg.DC <> 0) then
- begin
- if not (csCustomPaint in ControlState) and (ControlCount = 0) then
- inherited
- else
- PaintHandler(Msg);
- end
- else
- begin
- DC := GetDC(0);
- MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
- ReleaseDC(0, DC);
- MemDC := CreateCompatibleDC(0);
- OldBitmap := SelectObject(MemDC, MemBitmap);
- try
- DC := BeginPaint(Handle, PS);
- Perform(WM_ERASEBKGND, MemDC, MemDC);
- Msg.DC := MemDC;
- WMPaint(Msg);
- Msg.DC := 0;
- BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
- EndPaint(Handle, PS);
- finally
- SelectObject(MemDC, OldBitmap);
- DeleteDC(MemDC);
- DeleteObject(MemBitmap);
- end;
- end;
-end;
-
-(*
-begin
- {$IFDEF VER185}
- if TForm(FParentForm).FormStyle = fsMDIChild then
- begin
- DoubleBuffered := (Application.MainForm.ActiveMDIChild = FParentForm);
- end
- else
- DoubleBuffered := (FParentForm.Handle = GetActiveWindow);
- {$ENDIF}
- inherited;
-*)
-
-//------------------------------------------------------------------------------
-procedure TAdvCustomGlowButton.WMLButtonDown(var Msg:TWMLButtonDown);
-begin
- FGotButtonClick := true;
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-procedure TAdvCustomGlowButton.WMLButtonUp(var Msg:TWMLButtonDown);
-var
- DoClick: Boolean;
- inht: boolean;
-
-begin
- FTimeInc := -20;
- inht := false;
- GlowState := gsPush;
-
- FMouseDown := false;
- FLeftDown := false;
-
- if not Assigned(FTimer) then
- begin
- FTimer := TTimer.Create(self);
- FTimer.OnTimer := TimerProc;
- FTimer.Interval := GlowSpeed;
- FTimer.Enabled := true;
- end;
-
- if not DropDownButton and IsMenuButton then
- begin
- // do nothing
- end
- else
- if FDragging then
- begin
- FDragging := False;
-
- DoClick := (Msg.XPos >= 0) and (Msg.XPos < ClientWidth) and (Msg.YPos >= 0) and (Msg.YPos <= ClientHeight);
-
- if (FGroupIndex = 0) then
- begin
- // Redraw face in-case mouse is captured
- FState := absUp;
- FMouseInControl := False;
- //FHot := false;
-
- if (Style = bsCheck) then
- begin
- if Assigned(Action) then
- begin
- inherited;
- inht := true;
- if (FCheckLinked or FGroupIndexLinked) then
- Exit;
- {$IFDEF DELPHI7_LVL}
- if (Action is TAction) then
- if (Action as TAction).AutoCheck then
- Exit;
- {$ENDIF}
- end;
-
- // ***** extension for toolbar compactbutton handling
- if not DoClick and Self.Down then
- begin
- Self.Down := not Self.Down;
- end;
-
- if (Style <> bsCheck) then
- begin
- SetDown(not FDownChecked);
- end;
-
- //FState := absUp;
- Repaint;
- end;
- if DoClick and not (FState in [absExclusive, absDown]) then
- Invalidate;
- end
- else
- begin
- if Assigned(Action) then
- if FCheckLinked or FGroupIndexLinked then
- begin
- inherited;
- Exit;
- end;
-
- if DoClick then
- begin
- SetDown(not FDownChecked);
- if FDownChecked then
- Repaint;
- end
- else
- begin
- if FDownChecked then
- FState := absExclusive;
- Repaint;
- end;
-
- end;
-
- //if DoClick then
- // Click;
-
- UpdateTracking;
- end;
-
- if FGotButtonClick then
- ControlState := ControlState + [csClicked]
- else
- if Assigned(OnClick) then
- OnClick(Self);
-
- FGotButtonClick := false;
-
- if not inht then
- inherited;
-
- if (Style = bsCheck) or (GroupIndex > 0) then
- begin
- //FState := absUp;
- Repaint;
- //FHot := true;
- //FMouseInControl := true;
- end;
-
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.Notification(AComponent: TComponent;
- AOperation: TOperation);
-begin
- inherited;
- if (AOperation = opRemove) and (AComponent = FImages) then
- FImages := nil;
-
- if (AOperation = opRemove) and (AComponent = FDisabledImages) then
- FDisabledImages := nil;
-
- if (AOperation = opRemove) and (AComponent = FHotImages) then
- begin
- FHotImages := nil;
- end;
-
- if (AOperation = opRemove) and (AComponent = DropdownMenu) then
- DropdownMenu := nil;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.DrawGlyphCaption;
-begin
-
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.GetToolImage(bmp: TBitmap);
-begin
-
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDroppedDown(Value: Boolean);
-begin
- FDroppedDown := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.Paint;
-var
- GradColor: TColor;
- GradColorTo: TColor;
- GradColorMirror: TColor;
- GradColorMirrorTo: TColor;
- PenColor: TColor;
- GradB, GradU: TGDIPGradient;
- DrawDwLn: Boolean;
- ImgList: TImageList;
- Pic: TGDIPPicture;
- EnabledImg: Boolean;
- Rgn1, Rgn2: HRGN;
- R: TRect;
- i, w, h: Integer;
- p: TPoint;
- DCaption: string;
- DWideCaption: widestring;
- BD: TButtonDisplay;
- DrawFocused, DrawFocusedHot: boolean;
- bmp: TBitmap;
- sz: TSize;
- gs: TGlowButtonState;
- PicSize: TSize;
- AFont: TFont;
-
-begin
- if FPainting then
- Exit;
-
-
- FPainting := True;
- try
-
- if FTransparent and not FMouseEnter then
- begin
- // TRANSPARENCY CODE
-
- R := ClientRect;
- rgn1 := CreateRectRgn(R.Left, R.Top, R.Right, R.Bottom);
- SelectClipRgn(Canvas.Handle, rgn1);
-
- i := SaveDC(Canvas.Handle);
- p := ClientOrigin;
- Windows.ScreenToClient(Parent.Handle, p);
- p.x := -p.x;
- p.y := -p.y;
- MoveWindowOrg(Canvas.Handle, p.x, p.y);
-
- SendMessage(Parent.Handle, WM_ERASEBKGND, Canvas.Handle, 0);
- // transparency ?
- SendMessage(Parent.Handle, WM_PAINT, Canvas.Handle, 0);
-
- if (Parent is TWinCtrl) then
- (Parent as TWinCtrl).PaintCtrls(Canvas.Handle, nil);
-
- RestoreDC(Canvas.Handle, i);
-
- SelectClipRgn(Canvas.Handle, 0);
- DeleteObject(rgn1);
- end;
-
- if not Enabled then
- begin
- FState := absDisabled;
- FDragging := False;
- end
- else
- begin
- if (FState = absDisabled) then
- if FDownChecked and (GroupIndex <> 0) then
- FState := absExclusive
- else
- FState := absUp;
- end;
-
-
- if (Style = bsCheck) and (Down) then
- begin
- FState := absDown;
- end;
-
- with Appearance do
- begin
- DrawDwLn := False;
- if ((State = absDisabled) or not Enabled) and FShowDisabled then
- begin
- if (1>0) {Transparent} then
- begin
- GradColor := FColorDisabled;
- GradColorTo := FColorDisabledTo;
- GradColorMirror := FColorMirrorDisabled;
- GradColorMirrorTo := FColorMirrorDisabledTo;
- PenColor := BorderColorDisabled;
- GradU := GradientDisabled;
- GradB := GradientMirrorDisabled;
- end
- else
- begin
- end;
- end
- else if ((State = absDown) {or (FHot and (State = absExclusive))}{ or FDown}) and not ((Style = bsCheck) and (State = absDown)) then
- begin
- GradColor := FColorDown;
- GradColorTo := FColorDownTo;
- GradColorMirror := FColorMirrorDown;
- GradColorMirrorTo := FColorMirrorDownTo;
- PenColor := BorderColorDown;
- GradU := GradientDown;
- GradB := GradientMirrorDown;
- DrawDwLn := True;
- end
- else
- if (State = absExclusive) or ((Style = bsCheck) and (State = absDown)) then
- begin
- GradColor := FColorChecked;
- GradColorTo := FColorCheckedTo;
- GradColorMirror := FColorMirrorChecked;
- GradColorMirrorTo := FColorMirrorCheckedTo;
- PenColor := BorderColorChecked;
- GradU := GradientChecked;
- GradB := GradientMirrorChecked;
-
- if Assigned(FTimer) and not (not FMouseInControl and ((Style = bsCheck) or ((GroupIndex > 0) and (State <> absDown)))) then
- begin
- GradColor := BlendColor(FColorChecked, FColorDown, FStepPush);
- GradColorTo := BlendColor(FColorCheckedTo, FColorDownTo, FStepPush);
- GradColorMirror := BlendColor(FColorMirrorChecked, FColorMirrorDown, FStepPush);
- GradColorMirrorTo := BlendColor(FColorMirrorCheckedTo, FColorMirrorDownTo, FStepPush);
- //PenColor := BlendColor(BorderColorChecked, BorderColorDown, FStepPush);
- end;
-
- end
- else //if State = absUp then
- begin
- if FHot then
- begin
- GradColor := FColorHot;
- GradColorTo := FColorHotTo;
- GradColorMirror := FColorMirrorHot;
- GradColorMirrorTo := FColorMirrorHotTo;
- PenColor := BorderColorHot;
- GradU := GradientHot;
- GradB := GradientMirrorHot;
- DrawDwLn := True;
- end
- else // Normal draw
- begin
- if (1>0) {Transparent} then
- begin
- GradColor := FColor;
- GradColorTo := FColorTo;
- GradColorMirror := FColorMirror;
- GradColorMirrorTo := FColorMirrorTo;
- PenColor := BorderColor;
- GradU := Gradient;
- GradB := GradientMirror;
- end
- else
- begin
- end;
- end;
- end;
-
- { if FHot then
- begin
- GradColor := FColorHot;
- GradColorTo := FColorHotTo;
- GradColorMirror := FColorMirrorHot;
- GradColorMirrorTo := FColorMirrorHotTo;
- PenColor := BorderColorHot;
- GradU := GradientHot;
- GradB := GradientMirrorHot;
- end
- else
- begin
- GradColor := FColor;
- GradColorTo := FColorTo;
- GradColorMirror := FColorMirror;
- GradColorMirrorTo := FColorMirrorTo;
- PenColor := BorderColor;
- GradU := Gradient;
- GradB := GradientMirror;
- end;
-
- if FDown then
- begin
- PenColor := BorderColorDown;
- GradU := GradientDown;
- GradB := GradientMirrorDown;
- end;
- }
-
- if Assigned(FTimer) then
- begin
- if not FDown and not Transparent and not ((State = absExclusive) or ((Style = bsCheck) and (State = absDown))) then
- begin
- GradColor := BlendColor(FColorHot, FColor, FStepHover);
- GradColorTo := BlendColor(FColorHotTo, FColorTo, FStepHover);
- GradColorMirror := BlendColor(FColorMirrorHot, FColorMirror, FStepHover);
- GradColorMirrorTo := BlendColor(FColorMirrorHotTo, FColorMirrorTo, FStepHover);
- PenColor := BlendColor(BorderColorHot, BorderColor, FStepHover);
- end
- else
- begin
- if (Style = bsCheck) then
- begin
- if FDown then
- begin
- GradColor := BlendColor(FColorDown, FColorChecked, FStepPush);
- GradColorTo := BlendColor(FColorDownTo, FColorCheckedTo, FStepPush);
- GradColorMirror := BlendColor(FColorMirrorDown, FColorMirrorChecked, FStepPush);
- GradColorMirrorTo := BlendColor(FColorMirrorDownTo, FColorMirrorCheckedTo, FStepPush);
-// PenColor := BlendColor(BorderColorDown, BorderColorChecked, FStepPush);
- end
- end
- else
- if FDown and (State <> absExclusive) then
- begin
-
- GradColor := BlendColor(FColorDown, FColorHot, FStepPush);
- GradColorTo := BlendColor(FColorDownTo, FColorHotTo, FStepPush);
- GradColorMirror := BlendColor(FColorMirrorDown, FColorMirrorHot, FStepPush);
- GradColorMirrorTo := BlendColor(FColorMirrorDownTo, FColorMirrorHotTo, FStepPush);
- PenColor := BlendColor(BorderColorDown, BorderColorHot, FStepPush);
- end;
-
- end;
- end;
-
- if Enabled or (DisabledImages = nil) then
- begin
- if FHot and (HotImages <> nil) then
- ImgList := HotImages
- else
- ImgList := Images;
-
- EnabledImg := Enabled;
- end
- else
- begin
- ImgList := DisabledImages;
- EnabledImg := True;
- end;
-
- if Enabled or DisabledPicture.Empty then
- begin
- if FHot and not HotPicture.Empty then
- Pic := HotPicture
- else
- Pic := Picture;
- end
- else
- Pic := DisabledPicture;
-
-
- if (ImgList = nil) then
- begin
- ImgList := FInternalImages;
- EnabledImg := True;
- end;
-
- if ShowCaption then
- begin
- DCaption := Caption;
- DWideCaption := WideCaption;
- end
- else
- begin
- DCaption := '';
- DWideCaption := '';
- end;
-
- if (FMouseInControl or FMouseDown) and DropDownButton then
- begin
- if FInButton then
- BD := bdDropDown
- else
- BD := bdButton;
- end
- else
- BD := bdNone;
-
- // do not use special border color for non standalone buttons in mouse hover/down state or checked buttons
- if ((Position <> bpStandalone) and FMouseDown) {or ((Style = bsCheck) and (FState = absDown))} then
- begin
- PenColor := BorderColor;
- end;
-
- if ((State = absDisabled) or not Enabled) and FShowDisabled then
- begin
- GradColor := FColorDisabled;
- GradColorTo := FColorDisabledTo;
- GradColorMirror := FColorMirrorDisabled;
- GradColorMirrorTo := FColorMirrorDisabledTo;
- PenColor := BorderColorDisabled;
- GradU := GradientDisabled;
- GradB := GradientMirrorDisabled;
- end;
-
- if (FHasFocus and (FocusType in [ftHot, ftHotBorder])) and not FDown then
- begin
- GradColor := FColorHot;
- GradColorTo := FColorHotTo;
- GradColorMirror := FColorMirrorHot;
- GradColorMirrorTo := FColorMirrorHotTo;
- PenColor := BorderColorHot;
- GradU := GradientHot;
- GradB := GradientMirrorHot;
- DrawDwLn := True;
- end;
-
- DrawFocused := (FHasFocus) and (FocusType in [ftBorder, ftHotBorder]);
- DrawFocusedHot := (FHasFocus) and (FocusType in [ftHot, ftHotBorder]);
-
- AFont := TFont.Create;
- AFont.Assign(Font);
-
- if (not ParentFont) and Appearance.SystemFont then
- begin
- if IsVista then
- AFont.Name := 'Segoe UI'
- else
- AFont.Name := 'Tahoma';
- end;
-
- bmp := TBitmap.Create;
- bmp.Width := 1;
- bmp.Height := 1;
-
- GetToolImage(bmp);
-
- if Assigned(Action) then
- begin
- begin
- if ((Action as TCustomAction).ImageIndex >= 0) {and (ImageIndex = (Action as TCustomAction).ImageIndex)} then
- if Assigned((Action as TCustomAction).ActionList) then
- if Assigned(TImageList((Action as TCustomAction).ActionList.Images)) then
- begin
- ImgList := TImageList((Action as TCustomAction).ActionList.Images);
- EnabledImg := Enabled;
- FImageIndex := (Action as TCustomAction).ImageIndex;
- end;
- end;
- end;
-
- PicSize.cx := 0; // no stretch pic
- PicSize.cy := 0;
- if AutoSize then
- begin
- if (ButtonSizeState in [bsLabel, bsGlyph]) then
- begin
- PicSize.cx := 16;
- PicSize.cy := 16;
-
- {if (bmp.Width = 1) then
- begin
- bmp.Height := Pic.Height;
- bmp.Width := Pic.Width;
- bmp.Canvas.Draw(0, 0, Pic);
- Pic := nil;
- end;}
-
- if Assigned(ImgList) and (ImageIndex >= 0) then
- begin
- Pic := nil;
- end;
- end;
-
- if (ButtonSizeState = bsGlyph) then
- begin
- DCaption := '';
- DWideCaption := '';
- end;
- end;
-
- if DoAutoSize or (FFirstPaint and AutoSize) then
- begin
-
- sz := DrawVistaButton(Canvas,ClientRect,GradColor, GradColorTo, GradColorMirror, GradColorMirrorTo,
- PenColor, GradU, GradB, DCaption, DWideCaption, FDefaultCaptionDrawing, AFont, ImgList, ImageIndex, EnabledImg, Layout, FDropDownButton {and (Style <> bsCheck)},
- DrawDwLn, Enabled, DrawFocused, DropDownPosition, Pic, PicSize, AntiAlias, FDefaultPicDrawing, bmp, BD, Transparent and not (FMouseEnter or DrawFocusedHot or (State = absDown)), FMouseEnter, Position, DropDownSplit, CanDrawBorder,
- FOverlappedText, FWordWrap, True, FRounded, FDropDownDirection = ddDown, FSpacing, FTrimming, FNotes, FNotesFont, FDownChecked);
-
- if AutoSize then
- begin
- W := sz.cx + Spacing * 3 + 2 + 2 * MarginHorz;
- H := sz.cy + Spacing * 2 + 2 * MarginVert;
-
- if DropDownButton then
- begin
- if (DropDownPosition = dpBottom) then
- H := H + DropDownSectWidth
- else
- W := W + DropDownSectWidth;
- end;
-
- if Assigned(FOnSetButtonSize) then
- FOnSetButtonSize(Self, w, h);
-
- if (W <> Width) then
- Width := W;
- if (H <> Height) then
- Height := H;
- end;
-
- FFirstPaint := false;
- end;
-
- // transparent border pixels
-
- sz := DrawVistaButton(Canvas,ClientRect,GradColor, GradColorTo, GradColorMirror, GradColorMirrorTo,
- PenColor, GradU, GradB, DCaption, DWideCaption, FDefaultCaptionDrawing, AFont, ImgList, ImageIndex, EnabledImg, Layout, FDropDownButton {and (Style <> bsCheck)},
- DrawDwLn, Enabled, DrawFocused, DropDownPosition, Pic, PicSize, AntiAlias, FDefaultPicDrawing, bmp, BD, Transparent and not (FMouseEnter or DrawFocusedHot or (State = absDown)), FMouseEnter, Position, DropDownSplit, CanDrawBorder, FOverlappedText, FWordWrap,
- False, FRounded, FDropDownDirection = ddDown, FSpacing, FTrimming, FNotes, FNotesFont, FDownChecked);
-
- DrawGlyphCaption;
-
- gs := gsNormal;
-
- if FMouseEnter then
- gs := gsHot;
-
- if State = absDown then
- gs := gsDown;
-
- if Assigned(OnDrawButton) then
- OnDrawButton(Self, Canvas, ClientRect, gs);
-
- AFont.Free;
- bmp.Free;
-
- if not Assigned(Parent) then
- Exit;
-
- if not FTransparent or FMouseEnter or (State = absDown) or (FHot) then
- begin
- R := ClientRect;
-
- if Position <> bpMiddle then
- begin
- if (Position in [bpStandalone, bpLeft]) then
- begin
- rgn1 := CreateRectRgn(0, 0, 1, 1);
- end
- else
- begin
- rgn1 := CreateRectRgn(R.Right - 1, 0, R.Right, 1);
- end;
-
- if (Position in [bpStandalone]) then
- begin
- rgn2 := CreateRectRgn(R.Right - 1, 0, R.Right, 1);
- CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
- DeleteObject(rgn2);
- end;
-
- if (Position in [bpStandalone, bpLeft]) then
- begin
- rgn2 := CreateRectRgn(0, R.Bottom - 1, 1, R.Bottom);
- CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
- DeleteObject(rgn2);
- end;
-
- if (Position in [bpStandalone, bpRight]) then
- begin
- rgn2 := CreateRectRgn(R.Right - 1, R.Bottom - 1, R.Right, R.Bottom);
- CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
- DeleteObject(rgn2);
- end;
-
- SelectClipRgn(Canvas.Handle, rgn1);
-
- i := SaveDC(Canvas.Handle);
- p := ClientOrigin;
- Windows.ScreenToClient(Parent.Handle, p);
- p.x := -p.x;
- p.y := -p.y;
- MoveWindowOrg(Canvas.Handle, p.x, p.y);
-
- SendMessage(Parent.Handle, WM_ERASEBKGND, Canvas.Handle, 0);
-
- // transparency ?
- SendMessage(Parent.Handle, WM_PAINT, Canvas.Handle, 0);
- if (Parent is TWinCtrl) then
- (Parent as TWinCtrl).PaintCtrls(Canvas.Handle, nil);
- RestoreDC(Canvas.Handle, i);
-
- SelectClipRgn(Canvas.Handle, 0);
- DeleteObject(rgn1);
- end;
- end;
- end;
-
- finally
- FPainting := False;
- end;
-end;
-
-procedure TAdvCustomGlowButton.PictureChanged(Sender: TObject);
-begin
- PerformResize;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDown(Value: Boolean);
-begin
-
- if (csLoading in ComponentState) then
- FInitialDown := Value;
-
- if (FGroupIndex = 0) and (Style = bsButton) then
- Value := False;
-
- if (Style = bsCheck) then
- begin
- FDownChecked := Value;
- if FDownChecked then
- FState := absDown
- else
- FState := absUp;
- Repaint;
- Exit;
- end;
-
- if (Value <> FDownChecked) then
- begin
- if FDownChecked and (not FAllowAllUp) then
- Exit;
-
- FDownChecked := Value;
- if Value then
- begin
- if FState = absUp then Invalidate;
- FState := absExclusive
- end
- else
- begin
- FState := absUp;
- Repaint;
- end;
-
- if Value and not FCheckLinked then UpdateExclusive;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetGroupIndex(const Value: Integer);
-begin
- if FGroupIndex <> Value then
- begin
- FGroupIndex := Value;
- UpdateExclusive;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetImageIndex(const Value: TImageIndex);
-begin
- FImageIndex := Value;
- PerformResize;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetImages(const Value: TImageList);
-begin
- FImages := Value;
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDefault(const Value: boolean);
-begin
- FDefault := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDisabledImages(const Value: TImageList);
-begin
- FDisabledImages := Value;
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetSpacing(const Value: Integer);
-begin
- if FSpacing <> Value then
- begin
- FSpacing := value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-
-procedure TAdvCustomGlowButton.SetWideCaption(const Value: widestring);
-begin
- if (FWideCaption <> Value) then
- begin
- FWideCaption := Value;
-
- if AutoSize then
- begin
- DoAutoSize := true;
- Repaint;
- DoAutoSize := false;
- end
- else
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetWordWrap(const Value: Boolean);
-begin
- if FWordWrap <> Value then
- begin
- FWordWrap := Value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.PerformResize;
-begin
- if AutoSize then
- begin
- DoAutoSize := true;
- Repaint;
- DoAutoSize := false;
- end
- else
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetRounded(const Value: Boolean);
-begin
- if (FRounded <> Value) then
- begin
- FRounded := Value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetMarginVert(const Value: Integer);
-begin
- if FMarginVert <> Value then
- begin
- FMarginVert := Value;
- PerformResize;
- end;
-end;
-
-procedure TAdvCustomGlowButton.SetMarginHorz(const Value: Integer);
-begin
- if FMarginHorz <> Value then
- begin
- FMarginHorz := Value;
- PerformResize;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetAutoSizeEx(const Value: Boolean);
-begin
- if FAutoSize <> Value then
- begin
- FAutoSize := Value;
- PerformResize;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDisabledPicture(const Value: TGDIPPicture);
-begin
- FIDisabledPicture.Assign(Value);
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetHotPicture(const Value: TGDIPPicture);
-begin
- FIHotPicture.Assign(Value);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetShowCaption(const Value: Boolean);
-begin
- FShowCaption := Value;
- PerformResize;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.SetShowDisabled(const Value: boolean);
-begin
- FShowDisabled := Value;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.SetStyle(const Value: TAdvButtonStyle);
-begin
- if FStyle <> Value then
- begin
- FStyle := Value;
- //if (Value = bsCheck) and DropDownButton then
- // DropDownButton := false;
- end;
-end;
-
-procedure TAdvCustomGlowButton.SetVersion(const Value: string);
-begin
-
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.TimerProc(Sender: TObject);
-begin
- case GlowState of
- gsHover:
- begin
- FStepHover := FStepHover + FTimeInc;
- if ((FStepHover > 100) and (FTimeInc > 0))
- or ((FStepHover < 0) and (FTimeInc < 0)) then
- begin
- // outputdebugstring(pchar('hover step:'+inttostr(fstephover)+':'+inttostr(ftimeinc)));
- if FStepHover > 100 then
- FStepHover := 100;
-
- if FStepHover < 0then
- FStepHover := 0;
-
- GlowState := gsNone;
-
- FreeAndNil(FTimer);
- end
- else
- Invalidate;
- end;
- gsPush:
- begin
- // outputdebugstring(pchar('push step:'+inttostr(fsteppush)+':'+inttostr(ftimeinc)));
-
- FStepPush := FStepPush + FTimeInc;
-
- if ((FStepPush > 100) and (FTimeInc > 0))
- or ((FStepPush < 0) and (FTimeInc < 0)) then
- begin
- if FStepPush > 100 then
- FStepPush := 100;
-
- if FStepPush < 0 then
- FStepPush := 0;
-
- if FTimeInc < 0 then
- begin
- FDown := false;
- FLeftDown := false;
- end;
-
- GlowState := gsNone;
- FreeAndNil(FTimer);
- end
- else
- Invalidate;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.WMSetText(var Message: TWMSetText);
-begin
- inherited;
-
- if AutoSize then
- begin
- PerformResize;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.WMEraseBkGnd(var Message: TWMEraseBkGnd);
-const
- delta = 3;
-{
-var
- DC: HDC;
- i: THandle;
-// rgn1,rgn2: THandle;
- p,op: TPoint;
- PDC : HDC;
-}
-
-begin
- // SetBkMode(Message.DC, Windows.TRANSPARENT );
- Message.Result := 1;
- Exit;
-
- if FTransparent then
- begin
- if Assigned(Parent) and not (FMouseDown or FMouseInControl) then
- begin
- {
- rgn1 := CreateRectRgn(0, 0, delta, delta);
- rgn2 := CreateRectRgn(ClientRect.Right-delta, 0, ClientRect.Right, delta);
- CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
- rgn2 := CreateRectRgn(0, ClientRect.Bottom - delta, delta, ClientRect.Bottom);
- CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
- rgn2 := CreateRectRgn(ClientRect.Right - delta, ClientRect.Bottom - delta, ClientRect.Right, ClientRect.Bottom);
- CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
- SelectClipRgn(Message.DC, rgn1);
- }
-
- (*
- DC := Message.DC;
- i := SaveDC(DC);
-
- p := ClientOrigin;
- Windows.ScreenToClient(Parent.Handle, p);
- p.x := -p.x;
- p.y := -p.y;
-
-// MoveWindowOrg(DC, p.x, p.y);
-
-// SetMapMode(FBmp.Canvas.Handle,mm_isotropic);
-
- SetMapMode(FBmp.Canvas.Handle,mm_isotropic);
- SetViewPortOrgEx(FBmp.Canvas.Handle,p.x,p.y,@op);
-
- SendMessage(Parent.Handle, WM_ERASEBKGND, FBmp.Canvas.Handle, 0);
- SendMessage(Parent.Handle, WM_PAINT, FBmp.Canvas.Handle, 0);
-
-// if (Parent is TWinCtrl) then
-// (Parent as TWinCtrl).PaintCtrls(FBmp.Canvas.Handle, nil);
-
- SetViewPortOrgEx(FBmp.Canvas.Handle,op.x,op.y,nil);
- RestoreDC(DC, i);
-
- // SelectClipRgn(Message.DC, 0);
- // DeleteObject(rgn1);
- *)
- end;
- end
- else
- inherited;
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.CMDialogChar(var Message: TCMDialogChar);
-begin
- with Message do
- begin
- if Caption <> '' then
- begin
- if IsAccel(CharCode, Caption) and CanFocus then
- begin
- if IsMenuButton or (Assigned(DropDownMenu)) then
- DoDropDown
- else
- Click;
- Result := 1;
- end
- else
- inherited;
- end
- else
- begin
- if IsAccel(CharCode, WideCaption) and CanFocus then
- begin
- if IsMenuButton or (Assigned(DropDownMenu)) then
- DoDropDown
- else
- Click;
- Result := 1;
- end
- else
- inherited;
- end;
- end;
-end;
-
-procedure TAdvCustomGlowButton.CMDialogKey(var Message: TCMDialogKey);
-begin
- with Message do
- if
- (((CharCode = VK_RETURN) and FActive) or
- ((CharCode = VK_ESCAPE) and FCancel)) and
- (KeyDataToShiftState(Message.KeyData) = []) and CanFocus then
- begin
- //Click;
- InternalClick;
- FState := absUp;
- Result := 1;
- end
- else
- inherited;
-end;
-
-procedure TAdvCustomGlowButton.CMEnabledChanged(var Message: TMessage);
-begin
- inherited;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.CMFocusChanged(var Message: TCMFocusChanged);
-begin
- with Message do
- if Sender is TAdvCustomGlowButton then
- FActive := Sender = Self
- else
- FActive := FDefault;
- //SetButtonStyle(FActive);
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-
-{$IFNDEF TMSDOTNET}
-
-procedure TAdvCustomGlowButton.CMButtonPressed(var Message: TMessage);
-var
- Sender: TAdvGlowButton;
-begin
- if Message.WParam = FGroupIndex then
- begin
- Sender := TAdvGlowButton(Message.LParam);
- if Sender <> Self then
- begin
- if Sender.Down and FDownChecked then
- begin
- FDownChecked := False;
- FState := absUp;
- { if (Action is TCustomAction) then
- TCustomAction(Action).Checked := False; }
- Invalidate;
- end;
- //FAllowAllUp := Sender.AllowAllUp;
- end;
- end;
-end;
-{$ENDIF}
-
-//------------------------------------------------------------------------------
-
-{$IFNDEF TMSDOTNET}
-
-procedure TAdvCustomGlowButton.UpdateExclusive;
-var
- Msg: TMessage;
-begin
- if (FGroupIndex <> 0) and (Parent <> nil) then
- begin
- Msg.Msg := CM_BUTTONPRESSED;
- Msg.WParam := FGroupIndex;
- Msg.LParam := Longint(Self);
- Msg.Result := 0;
- Parent.Broadcast(Msg);
- {if Assigned(FAdvToolBar) and not (Parent is TAdvCustomToolBar) then
- FAdvToolBar.Broadcast(Msg)
- else if Assigned(AdvToolBar) and (Parent is TAdvCustomToolBar) and Assigned(AdvToolBar.FOptionWindowPanel) then
- FAdvToolBar.FOptionWindowPanel.Broadcast(Msg); }
- end;
-end;
-{$ENDIF}
-
-//------------------------------------------------------------------------------
-
-{$IFDEF TMSDOTNET}
-procedure TAdvCustomGlowButton.ButtonPressed(Group: Integer; Button: TAdvGlowButton);
-begin
- if (Group = FGroupIndex) and (Button <> Self) then
- begin
- if Button.Down and FDownChecked then
- begin
- FDownChecked := False;
- FState := absUp;
- if (Action is TCustomAction) then
- TCustomAction(Action).Checked := False;
- Invalidate;
- end;
- //FAllowAllUp := Button.AllowAllUp;
- end;
-end;
-
-procedure TAdvCustomGlowButton.UpdateExclusive;
-var
- I: Integer;
-begin
- if (FGroupIndex <> 0) and (Parent <> nil) then
- begin
- for I := 0 to Parent.ControlCount - 1 do
- if Parent.Controls[I] is TSpeedButton then
- TAdvToolButton(Parent.Controls[I]).ButtonPressed(FGroupIndex, Self);
- end;
-end;
-{$ENDIF}
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.UpdateTracking;
-var
- P: TPoint;
- FNewMouseInControl: boolean;
-begin
- //if FFlat then
- begin
- if Enabled then
- begin
- GetCursorPos(P);
-
- FNewMouseInControl := not (FindDragTarget(P, True) = Self);
-
- if FNewMouseInControl <> FMouseInControl then
- begin
- FMouseInControl := FNewMouseInControl;
- if FMouseInControl then
- Perform(CM_MOUSELEAVE, 0, 0)
- else
- Perform(CM_MOUSEENTER, 0, 0);
- end;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetAllowAllUp(const Value: Boolean);
-begin
- if FAllowAllUp <> Value then
- begin
- FAllowAllUp := Value;
- UpdateExclusive;
- end;
-end;
-
-procedure TAdvCustomGlowButton.SetAntiAlias(const Value: TAntiAlias);
-begin
- if (FAntiAlias <> Value) then
- begin
- FAntiAlias := Value;
- Invalidate;
- end;
-end;
-
-procedure TAdvCustomGlowButton.SetTrimming(const Value: TStringTrimming);
-begin
- if (FTrimming <> Value) then
- begin
- FTrimming := Value;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.MouseMove(Shift: TShiftState; X, Y: Integer);
-var
- NewState: TAdvButtonState;
- FOldInButton: Boolean;
-begin
- inherited;
-
- if (csDesigning in ComponentState) then
- Exit;
-
- {$IFNDEF DELPHI2006_LVL}
- UpdateTracking;
- {$ENDIF}
-
- FOldInButton := FInButton;
- FInButton := false;
-
- if DropDownButton then
- begin
- case DropDownPosition of
- dpRight: if X > Width - 12 then FInButton := true;
- dpBottom: if Y > Height - 12 then FInButton := true;
- end;
- end;
-
- if (FInButton <> FOldInButton) then
- begin
- Invalidate;
- end;
-
- if FDragging then
- begin
- if (not FDownChecked) then NewState := absUp
- else NewState := absExclusive;
-
- if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
- if FDownChecked then NewState := absExclusive else NewState := absDown;
-
- if (Style = bsCheck) and FDownChecked then
- begin
- NewState := absDown;
- end;
-
- if (NewState <> FState) then
- begin
- FState := NewState;
- Invalidate;
- end;
- end
- else
- if not FMouseInControl then
- UpdateTracking;
-
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetLayout(const Value: TButtonLayout);
-begin
- FLayout := Value;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.SetOfficeHint(const Value: TAdvHintInfo);
-begin
- FOfficeHint.Assign(Value);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetPicture(const Value: TGDIPPicture);
-begin
- FIPicture.Assign(Value);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetTransparent(const Value: Boolean);
-begin
- FTransparent := Value;
-// ReCreateWnd;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDropDownButton(const Value: Boolean);
-begin
- if FDropDownButton <> Value then
- begin
- //if (Value and not (Style = bsCheck)) or not Value then
- FDropDownButton := Value;
- AdjustSize;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDropDownDirection(const Value: TDropDownDirection);
-begin
- if FDropDownDirection <> Value then
- begin
- //if (Value and not (Style = bsCheck)) or not Value then
- FDropDownDirection := Value;
- Invalidate;
- end;
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.PopupBtnDown;
-begin
- if Assigned(FOnDropDown) then
- FOnDropDown(self);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetDropDownPosition(
- const Value: TDropDownPosition);
-begin
- if FDropDownPosition <> Value then
- begin
- FDropDownPosition := Value;
- if FDropDownButton then
- AdjustSize;
- Invalidate;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.OnAppearanceChanged(Sender: TObject);
-begin
- Invalidate;
- if Assigned(FShortCutHint) then
- begin
- FShortCutHint.Color := clWhite;
- FShortCutHint.ColorTo := Appearance.Color;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetAppearance(
- const Value: TGlowButtonAppearance);
-begin
- FAppearance.Assign(Value);
- if Assigned(FShortCutHint) then
- begin
- FShortCutHint.Color := clWhite;
- FShortCutHint.ColorTo := Appearance.Color;
- end;
-end;
-
-procedure TAdvCustomGlowButton.SetBorderStyle(const Value: TBorderStyle);
-begin
- FBorderStyle := Value;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.SetButtonPosition(const Value: TButtonPosition);
-begin
- FButtonPosition := Value;
- Invalidate;
-end;
-
-procedure TAdvCustomGlowButton.SetComponentStyle(AStyle: TTMSStyle);
-begin
- if (Astyle in [tsOffice2003Blue, tsOffice2003Silver, tsOffice2003Olive, tsWhidbey]) then
- begin
- Appearance.ColorHot := $EBFDFF;
- Appearance.ColorHotTo := $ACECFF;
- Appearance.ColorMirrorHot := $59DAFF;
- Appearance.ColorMirrorHotTo := $A4E9FF;
- Appearance.BorderColorHot := $99CEDB;
- Appearance.GradientHot := ggVertical;
- Appearance.GradientMirrorHot := ggVertical;
-
- Appearance.ColorDown := $76AFF1;
- Appearance.ColorDownTo := $4190F3;
- Appearance.ColorMirrorDown := $0E72F1;
- Appearance.ColorMirrorDownTo := $4C9FFD;
- Appearance.BorderColorDown := $45667B;
- Appearance.GradientDown := ggVertical;
- Appearance.GradientMirrorDown := ggVertical;
-
- Appearance.ColorChecked := $B5DBFB;
- Appearance.ColorCheckedTo := $78C7FE;
- Appearance.ColorMirrorChecked := $9FEBFD;
- Appearance.ColorMirrorCheckedTo := $56B4FE;
- Appearance.GradientChecked := ggVertical;
- Appearance.GradientMirrorChecked := ggVertical;
-
- end;
-
- case AStyle of
- tsOffice2003Blue:
- begin
- Appearance.Color := $EEDBC8;
- Appearance.ColorTo := $F6DDC9;
- Appearance.ColorMirror := $EDD4C0;
- Appearance.ColorMirrorTo := $F7E1D0;
- Appearance.BorderColor := $E0B99B;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
- end;
- tsOffice2003Olive:
- begin
- Appearance.Color := $CFF0EA;
- Appearance.ColorTo := $CFF0EA;
- Appearance.ColorMirror := $CFF0EA;
- Appearance.ColorMirrorTo := $8CC0B1;
- Appearance.BorderColor := $8CC0B1;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
- end;
- tsOffice2003Silver:
- begin
- Appearance.Color := $E6E9E2; //$EDD4C0;
- Appearance.ColorTo := $00E6D8D8;
- Appearance.ColorMirror := $E6E9E2; //$EDD4C0;
- Appearance.ColorMirrorTo := $C8B2B3;
- Appearance.BorderColor := $927476;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
- end;
- tsOffice2003Classic:
- begin
- Appearance.Color := clWhite;
- Appearance.ColorTo := $C9D1D5;
- Appearance.ColorMirror := clWhite;
- Appearance.ColorMirrorTo := $C9D1D5;
- Appearance.BorderColor := clBlack;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
-
- Appearance.ColorHot := $EBFDFF;
- Appearance.ColorHotTo := $ACECFF;
- Appearance.ColorMirrorHot := $59DAFF;
- Appearance.ColorMirrorHotTo := $A4E9FF;
- Appearance.BorderColorHot := $99CEDB;
- Appearance.GradientHot := ggVertical;
- Appearance.GradientMirrorHot := ggVertical;
-
- Appearance.ColorDown := $76AFF1;
- Appearance.ColorDownTo := $4190F3;
- Appearance.ColorMirrorDown := $0E72F1;
- Appearance.ColorMirrorDownTo := $4C9FFD;
- Appearance.BorderColorDown := $45667B;
- Appearance.GradientDown := ggVertical;
- Appearance.GradientMirrorDown := ggVertical;
-
- Appearance.ColorChecked := $B5DBFB;
- Appearance.ColorCheckedTo := $78C7FE;
- Appearance.ColorMirrorChecked := $9FEBFD;
- Appearance.ColorMirrorCheckedTo := $56B4FE;
- Appearance.GradientChecked := ggVertical;
- Appearance.GradientMirrorChecked := ggVertical;
-
- end;
- tsOffice2007Luna:
- begin
- Appearance.Color := $EEDBC8;
- Appearance.ColorTo := $F6DDC9;
- Appearance.ColorMirror := $EDD4C0;
- Appearance.ColorMirrorTo := $F7E1D0;
- Appearance.BorderColor := $E0B99B;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
-
- Appearance.ColorHot := $EBFDFF;
- Appearance.ColorHotTo := $ACECFF;
- Appearance.ColorMirrorHot := $59DAFF;
- Appearance.ColorMirrorHotTo := $A4E9FF;
- Appearance.BorderColorHot := $99CEDB;
- Appearance.GradientHot := ggVertical;
- Appearance.GradientMirrorHot := ggVertical;
-
- Appearance.ColorDown := $76AFF1;
- Appearance.ColorDownTo := $4190F3;
- Appearance.ColorMirrorDown := $0E72F1;
- Appearance.ColorMirrorDownTo := $4C9FFD;
- Appearance.BorderColorDown := $45667B;
- Appearance.GradientDown := ggVertical;
- Appearance.GradientMirrorDown := ggVertical;
-
- Appearance.ColorChecked := $B5DBFB;
- Appearance.ColorCheckedTo := $78C7FE;
- Appearance.ColorMirrorChecked := $9FEBFD;
- Appearance.ColorMirrorCheckedTo := $56B4FE;
- Appearance.BorderColorChecked := $45667B;
- Appearance.GradientChecked := ggVertical;
- Appearance.GradientMirrorChecked := ggVertical;
- end;
- tsOffice2007Obsidian:
- begin
- Appearance.Color := $DFDED6;
- Appearance.ColorTo := $E4E2DB;
- Appearance.ColorMirror := $D7D5CE;
- Appearance.ColorMirrorTo := $E7E5E0;
- Appearance.BorderColor := $C0BCB2;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
-
- Appearance.ColorHot := $EBFDFF;
- Appearance.ColorHotTo := $ACECFF;
- Appearance.ColorMirrorHot := $59DAFF;
- Appearance.ColorMirrorHotTo := $A4E9FF;
- Appearance.BorderColorHot := $99CEDB;
- Appearance.GradientHot := ggVertical;
- Appearance.GradientMirrorHot := ggVertical;
-
- Appearance.ColorDown := $76AFF1;
- Appearance.ColorDownTo := $4190F3;
- Appearance.ColorMirrorDown := $0E72F1;
- Appearance.ColorMirrorDownTo := $4C9FFD;
- Appearance.BorderColorDown := $45667B;
- Appearance.GradientDown := ggVertical;
- Appearance.GradientMirrorDown := ggVertical;
-
- Appearance.ColorChecked := $B5DBFB;
- Appearance.ColorCheckedTo := $78C7FE;
- Appearance.ColorMirrorChecked := $9FEBFD;
- Appearance.ColorMirrorCheckedTo := $56B4FE;
- Appearance.BorderColorChecked := $45667B;
- Appearance.GradientChecked := ggVertical;
- Appearance.GradientMirrorChecked := ggVertical;
-
- end;
- tsOffice2007Silver:
- begin
- Appearance.Color := $F3F3F1;
- Appearance.ColorTo := $F5F5F3;
- Appearance.ColorMirror := $EEEAE7;
- Appearance.ColorMirrorTo := $F8F7F6;
- Appearance.BorderColor := $CCCAC9;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
-
- Appearance.ColorHot := $EBFDFF;
- Appearance.ColorHotTo := $ACECFF;
- Appearance.ColorMirrorHot := $59DAFF;
- Appearance.ColorMirrorHotTo := $A4E9FF;
- Appearance.BorderColorHot := $99CEDB;
- Appearance.GradientHot := ggVertical;
- Appearance.GradientMirrorHot := ggVertical;
-
- Appearance.ColorDown := $76AFF1;
- Appearance.ColorDownTo := $4190F3;
- Appearance.ColorMirrorDown := $0E72F1;
- Appearance.ColorMirrorDownTo := $4C9FFD;
- Appearance.BorderColorDown := $45667B;
- Appearance.GradientDown := ggVertical;
- Appearance.GradientMirrorDown := ggVertical;
-
- Appearance.ColorChecked := $B5DBFB;
- Appearance.ColorCheckedTo := $78C7FE;
- Appearance.ColorMirrorChecked := $9FEBFD;
- Appearance.ColorMirrorCheckedTo := $56B4FE;
- Appearance.BorderColorChecked := $45667B;
- Appearance.GradientChecked := ggVertical;
- Appearance.GradientMirrorChecked := ggVertical;
- end;
- tsWindowsXP:
- begin
- Appearance.Color := clWhite;
- Appearance.ColorTo := $B9D8DC;
- Appearance.ColorMirror := $B9D8DC;
- Appearance.ColorMirrorTo := $B9D8DC;
- Appearance.BorderColor := $B9D8DC;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
-
- Appearance.ColorHot := $EFD3C6;
- Appearance.ColorHotTo := $EFD3C6;
- Appearance.ColorMirrorHot := $EFD3C6;
- Appearance.ColorMirrorHotTo := $EFD3C6;
- Appearance.BorderColorHot := clHighlight;
- Appearance.GradientHot := ggVertical;
- Appearance.GradientMirrorHot := ggVertical;
-
- Appearance.ColorDown := $B59284;
- Appearance.ColorDownTo := $B59284;
- Appearance.ColorMirrorDown := $B59284;
- Appearance.ColorMirrorDownTo := $B59284;
- Appearance.BorderColorDown := clHighlight;
- Appearance.GradientDown := ggVertical;
- Appearance.GradientMirrorDown := ggVertical;
-
-
- Appearance.ColorChecked := $B9D8DC;
- Appearance.ColorCheckedTo := $B9D8DC;
- Appearance.ColorMirrorChecked := $B9D8DC;
- Appearance.ColorMirrorCheckedTo := $B9D8DC;
- Appearance.BorderColorChecked := clBlack;
- Appearance.GradientChecked := ggVertical;
- Appearance.GradientMirrorChecked := ggVertical;
-
- end;
- tsWhidbey:
- begin
- Appearance.Color := clWhite;
- Appearance.ColorTo := $DFEDF0;
- Appearance.ColorMirror := $DFEDF0;
- Appearance.ColorMirrorTo := $DFEDF0;
- Appearance.BorderColor := $99A8AC;
- Appearance.Gradient := ggVertical;
- Appearance.GradientMirror := ggVertical;
-
- end;
- tsCustom:
- begin
- end;
- end;
- Invalidate;
-
- if Assigned(FShortCutHint) then
- begin
- FShortCutHint.Color := clWhite;
- FShortCutHint.ColorTo := Appearance.Color;
- end;
-
-end;
-
-
-//------------------------------------------------------------------------------
-
-//------------------------------------------------------------------------------
-
-{$IFDEF DELPHI6_LVL}
-procedure TAdvCustomGlowButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
-begin
- inherited ActionChange(Sender, CheckDefaults);
- if Sender is TCustomAction then
- with TCustomAction(Sender) do
- begin
-
- if CheckDefaults or (Self.GroupIndex = 0) then
- Self.GroupIndex := GroupIndex;
- if (csDesigning in ComponentState)
- {$IFDEF DELPHI2006_LVL}
- or not self.StaticActionImageIndex
- {$ENDIF}
- then
- begin
- if ActionHasImages then
- Self.ImageIndex := ImageIndex;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGlowButton.GetActionLinkClass: TControlActionLinkClass;
-begin
- Result := TAdvGlowButtonActionLink;
-end;
-{$ENDIF}
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetButtonSizeState(
- const Value: TButtonSizeState);
-begin
- if (FButtonSizeState <> Value) {and AutoSize} then
- begin
- if (FButtonSizeState = bsLarge) then
- begin
- FOldLayout := Layout;
- FOldDropDownPosition := DropDownPosition;
- end;
-
- FButtonSizeState := Value;
-
- if (FButtonSizeState = bsLarge) and AutoSize then
- begin
- Layout := FOldLayout;
- DropDownPosition := FOldDropDownPosition;
- end
- else if AutoSize then
- begin
- Layout := blGlyphLeft;
- DropDownPosition := dpRight;
- end;
- FFirstPaint := True;
- Paint;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetMaxButtonSizeState(
- const Value: TButtonSizeState);
-begin
- if (FMaxButtonSizeState <> Value) {and AutoSize} then
- begin
- FMaxButtonSizeState := Value;
- ButtonSizeState := FMaxButtonSizeState
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGlowButton.GetNotes: TStrings;
-begin
- Result := TStrings(FNotes);
-end;
-
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetNotes(const Value: TStrings);
-begin
- FNotes.Assign(Value);
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetNotesFont(const Value: TFont);
-begin
- FNotesFont.Assign(Value);
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvCustomGlowButton.SetMinButtonSizeState(
- const Value: TButtonSizeState);
-begin
- if (FMinButtonSizeState <> Value) then
- begin
- FMinButtonSizeState := Value;
- if (FMinButtonSizeState > ButtonSizeState) then
- ButtonSizeState := FMinButtonSizeState;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvCustomGlowButton.GetButtonSize(BtnSizeState: TButtonSizeState): TSize;
-var
- DCaption: string;
- DWideCaption: widestring;
- ImgList: TImageList;
- Pic: TGDIPPicture;
- EnabledImg: Boolean;
- BD: TButtonDisplay;
- bmp: TBitmap;
- DrawFocused, DrawFocusedHot, DrawDwLn: boolean;
- PicSize: TSize;
- LayOt: TButtonLayout;
- DpDwPosition: TDropDownPosition;
-begin
- if Enabled or (DisabledImages = nil) then
- begin
- if FHot and (HotImages <> nil) then
- ImgList := HotImages
- else
- ImgList := Images;
-
- EnabledImg := Enabled;
- end
- else
- begin
- ImgList := DisabledImages;
- EnabledImg := True;
- end;
-
- if Enabled or DisabledPicture.Empty then
- begin
- if FHot and not HotPicture.Empty then
- Pic := HotPicture
- else
- Pic := Picture;
- end
- else
- Pic := DisabledPicture;
-
-
- if (ImgList = nil) then
- begin
- ImgList := FInternalImages;
- EnabledImg := True;
- end;
-
- if ShowCaption then
- begin
- DCaption := Caption;
- DWideCaption := WideCaption;
- end
- else
- begin
- DCaption := '';
- DWideCaption := '';
- end;
-
- if (FMouseInControl or FMouseDown) and DropDownButton then
- begin
- if FInButton then
- BD := bdDropDown
- else
- BD := bdButton;
- end
- else
- BD := bdNone;
-
- DrawFocused := (FHasFocus) and (FocusType in [ftBorder, ftHotBorder]);
- DrawFocusedHot := (FHasFocus) and (FocusType in [ftHot, ftHotBorder]);
-
- bmp := TBitmap.Create;
- bmp.Width := 1;
- bmp.Height := 1;
-
- GetToolImage(bmp);
-
- if Assigned(Action) then
- begin
- begin
- if ((Action as TCustomAction).ImageIndex >= 0) and (ImageIndex = (Action as TCustomAction).ImageIndex) then
- if Assigned((Action as TCustomAction).ActionList) then
- if Assigned(TImageList((Action as TCustomAction).ActionList.Images)) then
- begin
- ImgList := TImageList((Action as TCustomAction).ActionList.Images);
- EnabledImg := Enabled;
- end;
- end;
- end;
-
- LayOt := Layout;
- DpDwPosition := DropDownPosition;
-
- PicSize.cx := 0; // no stretch pic
- PicSize.cy := 0;
- if AutoSize then
- begin
- if (BtnSizeState in [bsLabel, bsGlyph]) then
- begin
- PicSize.cx := 16;
- PicSize.cy := 16;
-
- if (bmp.Width = 1) then
- begin
- bmp.Height := Pic.Height;
- bmp.Width := Pic.Width;
- bmp.Canvas.Draw(0, 0, Pic);
- Pic := nil;
- end;
-
- if Assigned(ImgList) and (ImageIndex >= 0) then
- begin
- Pic := nil;
- end;
- end;
-
- if (BtnSizeState = bsGlyph) then
- begin
- DCaption := '';
- DWideCaption := '';
- end;
-
- if (BtnSizeState = bsLarge) then
- begin
- LayOt := FOldLayout;
- DpDwPosition := FOldDropDownPosition;
- end
- else
- begin
- LayOt := blGlyphLeft;
- DpDwPosition := dpRight;
- end;
- end;
-
- DrawDwLn := False;
-
- with Appearance do
- Result := DrawVistaButton(Canvas,ClientRect,FColor, FColorTo, FColorMirror, FColorMirrorTo,
- BorderColor, Gradient, GradientMirror, DCaption, DWideCaption, FDefaultCaptionDrawing, Font, ImgList, ImageIndex, EnabledImg, LayOt, FDropDownButton,
- DrawDwLn, Enabled, DrawFocused, DpDwPosition, Pic, PicSize, AntiAlias, FDefaultPicDrawing, bmp, BD, Transparent and not (FMouseEnter or DrawFocusedHot or (State = absDown)), FMouseEnter, Position, DropDownSplit, CanDrawBorder,
- FOverlappedText, FWordWrap, True, FRounded, FDropDownDirection = ddDown, FSpacing, FTrimming, FNotes, FNotesFont, FDownChecked);
-
- Result.cx := Result.cx + Spacing * 3 + 2 + 2 * MarginHorz;
- Result.cy := Result.cy + Spacing * 2 + 2 * MarginVert;
- if DropDownButton then
- begin
- if (DpDwPosition = dpBottom) then
- Result.cy := Result.cy + DropDownSectWidth
- else
- Result.cx := Result.cx + DropDownSectWidth;
- end;
- //if Assigned(FOnSetButtonSize) then
- //FOnSetButtonSize(Self, w, h);
-
- bmp.Free;
-end;
-
-//------------------------------------------------------------------------------
-
-{ TGlowButtonAppearance }
-
-constructor TGlowButtonAppearance.Create;
-begin
- inherited;
- Color := clWhite;
- ColorTo := clWhite;
- ColorMirror := clSilver;
- ColorMirrorTo := clWhite;
-
- ColorHot := $F5F0E1;
- ColorHotTo := $F9D2B2;
- ColorMirrorHot := $F5C8AD;
- ColorMirrorHotTo := $FFF8F4;
-
- ColorDown := BrightnessColor($F5F0E1,-10,-10,0);
- ColorDownTo := BrightnessColor($F9D2B2, -10,-10,0);
- ColorMirrorDown := BrightnessColor($F5C8AD, -10,-10,0);
- ColorMirrorDownTo := BrightnessColor($FFF8F4, -10,-10,0);
-
- ColorChecked := BrightnessColor($F5F0E1,-10,-10,0);
- ColorCheckedTo := BrightnessColor($F9D2B2, -10,-10,0);
- ColorMirrorChecked := BrightnessColor($F5C8AD, -10,-10,0);
- ColorMirrorCheckedTo := BrightnessColor($FFF8F4, -10,-10,0);
-
- ColorDisabled := BrightnessColor(clWhite,-5,-5,-5);
- ColorDisabledTo := BrightnessColor(clWhite, -5,-5,-5);
- ColorMirrorDisabled := BrightnessColor(clSilver, -5,-5,-5);
- ColorMirrorDisabledTo := BrightnessColor(clWhite, -5,-5,-5);
-
- BorderColor := clSilver;
- BorderColorHot := clBlue;
- BorderColorDown := clNavy;
- BorderColorChecked := clBlue;
- BorderColorDisabled := clGray;
-
- Gradient := ggVertical;
- GradientMirror := ggVertical;
-
- GradientHot := ggRadial;
- GradientMirrorHot := ggRadial;
-
- GradientDown := ggRadial;
- GradientMirrorDown := ggRadial;
-
- GradientChecked := ggRadial;
- GradientMirrorChecked := ggVertical;
-
- GradientDisabled := ggRadial;
- GradientMirrorDisabled := ggRadial;
-
- FSystemFont := true;
-end;
-
-procedure TGlowButtonAppearance.SetSystemFont(const Value: boolean);
-begin
- if (FSystemFont <> Value) then
- begin
- FSystemFont := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.Assign(Source: TPersistent);
-begin
- if (Source is TGlowButtonAppearance) then
- begin
- Color := (Source as TGlowButtonAppearance).Color;
- ColorTo := (Source as TGlowButtonAppearance).ColorTo;
- ColorMirror := (Source as TGlowButtonAppearance).ColorMirror;
- ColorMirrorTo := (Source as TGlowButtonAppearance).ColorMirrorTo;
-
- ColorHot := (Source as TGlowButtonAppearance).ColorHot;
- ColorHotTo := (Source as TGlowButtonAppearance).ColorHotTo;
- ColorMirrorHot := (Source as TGlowButtonAppearance).ColorMirrorHot;
- ColorMirrorHotTo := (Source as TGlowButtonAppearance).ColorMirrorHotTo;
-
- ColorDown := (Source as TGlowButtonAppearance).ColorDown;
- ColorDownTo := (Source as TGlowButtonAppearance).ColorDownTo;
- ColorMirrorDown := (Source as TGlowButtonAppearance).ColorMirrorDown;
- ColorMirrorDownTo := (Source as TGlowButtonAppearance).ColorMirrorDownTo;
-
- ColorChecked := (Source as TGlowButtonAppearance).ColorChecked;
- ColorCheckedTo := (Source as TGlowButtonAppearance).ColorCheckedTo;
- ColorMirrorChecked := (Source as TGlowButtonAppearance).ColorMirrorChecked;
- ColorMirrorCheckedTo := (Source as TGlowButtonAppearance).ColorMirrorCheckedTo;
-
- ColorDisabled := (Source as TGlowButtonAppearance).ColorDisabled;
- ColorDisabledTo := (Source as TGlowButtonAppearance).ColorDisabledTo;
- ColorMirrorDisabled := (Source as TGlowButtonAppearance).ColorMirrorDisabled;
- ColorMirrorDisabledTo := (Source as TGlowButtonAppearance).ColorMirrorDisabledTo;
-
- BorderColor := (Source as TGlowButtonAppearance).BorderColor;
- BorderColorHot := (Source as TGlowButtonAppearance).BorderColorHot;
- BorderColorDown := (Source as TGlowButtonAppearance).BorderColorDown;
- BorderColorChecked := (Source as TGlowButtonAppearance).BorderColorChecked;
- BorderColorDisabled := (Source as TGlowButtonAppearance).BorderColorDisabled;
-
- Gradient := (Source as TGlowButtonAppearance).Gradient;
- GradientMirror := (Source as TGlowButtonAppearance).GradientMirror;
-
- GradientHot := (Source as TGlowButtonAppearance).GradientHot;
- GradientMirrorHot := (Source as TGlowButtonAppearance).GradientMirrorHot;
-
- GradientDown := (Source as TGlowButtonAppearance).GradientDown;
- GradientMirrorDown := (Source as TGlowButtonAppearance).GradientMirrorDown;
-
- GradientChecked := (Source as TGlowButtonAppearance).GradientChecked;
- GradientMirrorChecked := (Source as TGlowButtonAppearance).GradientMirrorChecked;
-
- GradientDisabled := (Source as TGlowButtonAppearance).GradientDisabled;
- GradientMirrorDisabled := (Source as TGlowButtonAppearance).GradientMirrorDisabled;
-
- SystemFont := (Source as TGlowButtonAppearance).SystemFont;
- end
- else
- inherited Assign(Source);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.Changed;
-begin
- if Assigned(FOnChange) then
- FOnChange(Self);
-end;
-
-procedure TGlowButtonAppearance.SetBorderColor(const Value: TColor);
-begin
- if (FBorderColor <> Value) then
- begin
- FBorderColor := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetBorderColorChecked(const Value: TColor);
-begin
- if (FBorderColorChecked <> Value) then
- begin
- FBorderColorChecked := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetBorderColorDisabled(
- const Value: TColor);
-begin
- if (FBorderColorDisabled <> Value) then
- begin
- FBorderColorDisabled := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetBorderColorDown(const Value: TColor);
-begin
- if (FBorderColorDown <> Value) then
- begin
- FBorderColorDown := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetBorderColorHot(const Value: TColor);
-begin
- if (FBorderColorHot <> Value) then
- begin
- FBorderColorHot := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColor(const Value: TColor);
-begin
- if (FColor <> Value) then
- begin
- FColor := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorChecked(const Value: TColor);
-begin
- if (FColorChecked <> Value) then
- begin
- FColorChecked := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorCheckedTo(const Value: TColor);
-begin
- if (FColorCheckedTo <> Value) then
- begin
- FColorCheckedTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorDisabled(const Value: TColor);
-begin
- if (FColorDisabled <> Value) then
- begin
- FColorDisabled := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorDisabledTo(const Value: TColor);
-begin
- if (FColorDisabledTo <> Value) then
- begin
- FColorDisabledTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorDown(const Value: TColor);
-begin
- if (FColorDown <> Value) then
- begin
- FColorDown := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorDownTo(const Value: TColor);
-begin
- if (FColorDownTo <> Value) then
- begin
- FColorDownTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorHot(const Value: TColor);
-begin
- if (FColorHot <> Value) then
- begin
- FColorHot := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorHotTo(const Value: TColor);
-begin
- if (FColorHotTo <> Value) then
- begin
- FColorHotTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirror(const Value: TColor);
-begin
- if (FColorMirror <> Value) then
- begin
- FColorMirror := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorChecked(const Value: TColor);
-begin
- if (FColorMirrorChecked <> Value) then
- begin
- FColorMirrorChecked := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorCheckedTo(
- const Value: TColor);
-begin
- if (FColorMirrorCheckedTo <> Value) then
- begin
- FColorMirrorCheckedTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorDisabled(
- const Value: TColor);
-begin
- if (FColorMirrorDisabled <> Value) then
- begin
- FColorMirrorDisabled := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorDisabledTo(
- const Value: TColor);
-begin
- if (FColorMirrorDisabledTo <> Value) then
- begin
- FColorMirrorDisabledTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorDown(const Value: TColor);
-begin
- if (FColorMirrorDown <> Value) then
- begin
- FColorMirrorDown := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorDownTo(const Value: TColor);
-begin
- if (FColorMirrorDownTo <> Value) then
- begin
- FColorMirrorDownTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorHot(const Value: TColor);
-begin
- if (FColorMirrorHot <> Value) then
- begin
- FColorMirrorHot := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorHotTo(const Value: TColor);
-begin
- if (FColorMirrorHotTo <> Value) then
- begin
- FColorMirrorHotTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorMirrorTo(const Value: TColor);
-begin
- if (FColorMirrorTo <> Value) then
- begin
- FColorMirrorTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetColorTo(const Value: TColor);
-begin
- if (FColorTo <> Value) then
- begin
- FColorTo := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradient(const Value: TGDIPGradient);
-begin
- if (FGradient <> Value) then
- begin
- FGradient := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientChecked(
- const Value: TGDIPGradient);
-begin
- if (FGradientChecked <> Value) then
- begin
- FGradientChecked := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientDisabled(
- const Value: TGDIPGradient);
-begin
- if (FGradientDisabled <> Value) then
- begin
- FGradientDisabled := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientDown(
- const Value: TGDIPGradient);
-begin
- if (FGradientDown <> Value) then
- begin
- FGradientDown := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientHot(const Value: TGDIPGradient);
-begin
- if (FGradientHot <> Value) then
- begin
- FGradientHot := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientMirror(
- const Value: TGDIPGradient);
-begin
- if (FGradientMirror <> Value) then
- begin
- FGradientMirror := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientMirrorChecked(
- const Value: TGDIPGradient);
-begin
- if (FGradientMirrorChecked <> Value) then
- begin
- FGradientMirrorChecked := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientMirrorDisabled(
- const Value: TGDIPGradient);
-begin
- if (FGradientMirrorDisabled <> Value) then
- begin
- FGradientMirrorDisabled := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientMirrorDown(
- const Value: TGDIPGradient);
-begin
- if (FGradientMirrorDown <> Value) then
- begin
- FGradientMirrorDown := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TGlowButtonAppearance.SetGradientMirrorHot(
- const Value: TGDIPGradient);
-begin
- if (FGradientMirrorHot <> Value) then
- begin
- FGradientMirrorHot := Value;
- Changed;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-{$IFNDEF TMS_STD}
-
-{ TDBATBButtonDataLink }
-
-constructor TDBGlowButtonDataLink.Create;
-begin
- inherited Create;
- FOnEditingChanged := nil;
- FOnDataSetChanged := nil;
- FOnActiveChanged := nil;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBGlowButtonDataLink.ActiveChanged;
-begin
- if Assigned(FOnActiveChanged) then FOnActiveChanged(Self);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBGlowButtonDataLink.DataSetChanged;
-begin
- if Assigned(FOnDataSetChanged) then FOnDataSetChanged(Self);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBGlowButtonDataLink.EditingChanged;
-begin
- if Assigned(FOnEditingChanged) then FOnEditingChanged(Self);
-end;
-
-//------------------------------------------------------------------------------
-
-{ TDBAdvToolBarButton }
-
-constructor TDBAdvGlowButton.Create(AOwner: TComponent);
-begin
- inherited;
- FAutoDisable := True;
- FDBButtonType := dbCustom;
- FDisableControls := [];
- FDataLink := TDBGlowButtonDataLink.Create;
- with FDataLink do
- begin
- OnEditingChanged := OnDataSetEvents;
- OnDataSetChanged := OnDataSetEvents;
- OnActiveChanged := OnDataSetEvents;
- end;
- FConfirmActionString := '';
-end;
-
-//------------------------------------------------------------------------------
-
-destructor TDBAdvGlowButton.Destroy;
-begin
- FDataLink.Free;
- FDataLink := nil;
- if (FInternalImages <> nil) then
- FInternalImages.Free;
- inherited;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.CalcDisableReasons;
-begin
- case FDBButtonType of
- dbPrior: FDisableControls := [drBOF, drEditing, drEmpty];
- dbNext: FDisableControls := [drEOF, drEditing, drEmpty];
- dbFirst: FDisableControls := [drBOF, drEditing, drEmpty];
- dbLast: FDisableControls := [drEOF, drEditing, drEmpty];
- dbInsert,
- dbAppend: FDisableControls := [drReadonly, drEditing];
- dbEdit: FDisableControls := [drReadonly, drEditing, drEmpty];
- dbCancel: FDisableControls := [drNotEditing];
- dbPost: FDisableControls := [drNotEditing];
- dbRefresh: FDisableControls := [drEditing];
- dbDelete: FDisableControls := [drReadonly, drEditing, drEmpty];
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.Click;
-begin
- inherited;
- DoAction;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.CMEnabledChanged(var Message: TMessage);
-begin
- inherited;
- if (not FInProcUpdateEnabled) and
- (not (csLoading in ComponentState)) and
- (not (csDestroying in ComponentState)) then
- begin
- UpdateEnabled;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.DoAction;
-var
- DoAction: Boolean;
- ShowException: Boolean;
-begin
- if not DoConfirmAction then
- Exit;
-
- DoAction := (FDBButtonType <> dbCustom);
- try
- DoBeforeAction(DoAction);
- if DoAction and (DataSource <> nil) and (DataSource.State <> dsInactive) then
- begin
- with DataSource.DataSet do
- begin
- case FDBButtonType of
- dbPrior: Prior;
- dbNext: Next;
- dbFirst: First;
- dbLast: Last;
- dbInsert: Insert;
- dbAppend: Append;
- dbEdit: Edit;
- dbCancel: Cancel;
- dbPost: Post;
- dbRefresh:Refresh;
- dbDelete: Delete;
- end;
- end;
- end;
- ShowException := false;
- except
- ShowException := true;
- if Assigned(FOnAfterAction) then
- FOnAfterAction(self, ShowException);
- if ShowException then
- raise;
- ShowException := true;
- end;
- if not ShowException and DoAction and Assigned(FOnAfterAction) then
- FOnAfterAction(self, ShowException);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.DoBeforeAction(var DoAction: Boolean);
-begin
- if (not (csDesigning in ComponentState)) and Assigned(FOnBeforeAction) then
- FOnBeforeAction(self, DoAction);
-end;
-
-//------------------------------------------------------------------------------
-
-function TDBAdvGlowButton.DoConfirmAction: Boolean;
-var
- Question: string;
- QuestionButtons: TMsgDlgButtons;
- QuestionHelpCtx: Longint;
- QuestionResult: Longint;
-begin
- DoGetQuestion(Question, QuestionButtons, QuestionHelpCtx);
- if (Question <> '') then
- begin
- QuestionResult := MessageDlg(Question, mtConfirmation, QuestionButtons, QuestionHelpCtx);
- Result := (QuestionResult = idOk) or (QuestionResult = idYes);
- end
- else
- Result := true;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.DoGetQuestion(var Question: string;
- var Buttons: TMsgDlgButtons; var HelpCtx: Integer);
-begin
- Question := '';
- if FConfirmAction then
- begin
- Question := FConfirmActionString;
- Buttons := mbOKCancel;
- HelpCtx := 0;
- if Assigned(FOnGetConfirm) then
- FOnGetConfirm(self, Question, Buttons, HelpCtx);
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TDBAdvGlowButton.GetDataSource: TDataSource;
-begin
- Result := FDataLink.DataSource;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.Notification(AComponent: TComponent;
- AOperation: TOperation);
-begin
- inherited;
- if (AOperation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then
- DataSource := nil;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.SetDataSource(const Value: TDataSource);
-begin
- FDataLink.DataSource := Value;
- if not (csLoading in ComponentState) then
- UpdateEnabled;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.SetDBButtonType(const Value: TDBGlowButtonType);
-begin
- if (Value = FDBButtonType) then
- Exit;
-
- if (Value = dbDelete) and (FConfirmActionString = ''){and ConfirmAction} then
- FConfirmActionString := SDeleteRecordQuestion; //'Delete Record?';
-
- if (csReading in ComponentState) or (csLoading in ComponentState) then
- begin
- FDBButtonType := Value;
- CalcDisableReasons;
- exit;
- end;
-
- FDBButtonType := Value;
- LoadGlyph;
- CalcDisableReasons;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.UpdateEnabled;
-var
- PossibleDisableReasons: TDBBDisableControls;
- GetEnable: Boolean;
- WasEnabled: Boolean;
-begin
- if (csDesigning in ComponentState) or (csDestroying in ComponentState) or not FAutoDisable then
- Exit;
-
- FInProcUpdateEnabled := true;
- try
- WasEnabled := Enabled;
- if FDataLink.Active then
- begin
- PossibleDisableReasons := [];
- if FDataLink.DataSet.BOF then
- Include(PossibleDisableReasons, drBOF);
- if FDataLink.DataSet.EOF then
- Include(PossibleDisableReasons, drEOF);
- if not FDataLink.DataSet.CanModify then
- Include(PossibleDisableReasons, drReadonly);
- if FDataLink.DataSet.BOF and FDataLink.DataSet.EOF then
- Include(PossibleDisableReasons, drEmpty);
- if FDataLink.Editing then
- Include(PossibleDisableReasons, drEditing)
- else
- Include(PossibleDisableReasons, drNotEditing);
-
- GetEnable := ((FDisableControls - [drEvent])* PossibleDisableReasons = []);
- if (drEvent in FDisableControls) and (Assigned(FOnGetEnabled)) then
- FOnGetEnabled(Self, GetEnable);
- Enabled := GetEnable;
- end
- else
- Enabled := false;
-
- if (WasEnabled <> Enabled) and Assigned(FOnEnabledChanged) then
- FOnEnabledChanged(self);
- finally
- FInProcUpdateEnabled := false;
- end;
- LoadGlyph;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.Loaded;
-begin
- inherited;
- //if not Assigned(Images) then
- LoadGlyph;
-
- UpdateEnabled;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.OnDataSetEvents(Sender: TObject);
-begin
- UpdateEnabled;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TDBAdvGlowButton.LoadGlyph;
-var
- Glyph: TBitMap;
-begin
- if (csLoading in ComponentState) or Assigned(Images) or (not Enabled and Assigned(DisabledImages)) then
- Exit;
-
- if (FDBButtonType = dbCustom) then
- Exit;
-
- if (FInternalImages = nil) then
- FInternalImages := TImageList.Create(self);
-
- FInternalImages.Clear;
- Glyph := TBitMap.Create;
- Glyph.Width := 16;
- Glyph.Height := 16;
- Glyph.Transparent := True;
-
- case FDBButtonType of
- dbPrior:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGPRIOR')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGPRIORD');
- end;
- dbNext:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGNEXT')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGNEXTD');
- end;
- dbFirst:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGFIRST')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGFIRSTD');
- end;
- dbLast:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGLAST')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGLASTD');
- end;
- dbInsert:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGINSERT')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGINSERTD');
- end;
- dbAppend:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGINSERT')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGINSERTD');
- end;
- dbEdit:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGEDIT')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGEDITD');
- end;
- dbCancel:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGCANCEL')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGCANCELD');
- end;
- dbPost:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGPOST')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGPOSTD');
- end;
- dbRefresh:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGREFRESH')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGREFRESHD');
- end;
- dbDelete:
- begin
- if Enabled then
- Glyph.LoadFromResourceName(HInstance, 'DBIMGDELETE')
- else
- Glyph.LoadFromResourceName(HInstance, 'DBIMGDELETED');
- end;
- end;
-
- FInternalImages.DrawingStyle := dsTransparent;
- FInternalImages.Masked := true;
- FInternalImages.AddMasked(Glyph, clFuchsia);
- FImageIndex := 0;
- Glyph.Free;
- Invalidate;
-end;
-
-//------------------------------------------------------------------------------
-
-
-procedure TDBAdvGlowButton.SetConfirmActionString(const Value: String);
-begin
- if FConfirmActionString <> Value then
- begin
- FConfirmActionString := Value;
- end;
-end;
-
-{$ENDIF}
-
-//------------------------------------------------------------------------------
-
-{$IFDEF DELPHI6_LVL}
-
-{ TAdvGlowButtonActionLink }
-
-procedure TAdvGlowButtonActionLink.AssignClient(AClient: TObject);
-
-begin
- inherited AssignClient(AClient);
- FClient := AClient as TAdvCustomGlowButton;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvGlowButtonActionLink.IsCheckedLinked: Boolean;
-begin
- Result := inherited IsCheckedLinked {and (FClient.GroupIndex <> 0) and
- FClient.AllowAllUp} and (FClient.Down = (Action as TCustomAction).Checked);
-
- FClient.CheckLinked := Result;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvGlowButtonActionLink.IsGroupIndexLinked: Boolean;
-begin
- Result := (FClient is TAdvCustomGlowButton) and
- (TAdvCustomGlowButton(FClient).GroupIndex = (Action as TCustomAction).GroupIndex);
-
- FClient.GroupIndexLinked := Result;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvGlowButtonActionLink.SetImageIndex(Value: Integer);
-begin
- if IsGroupIndexLinked then
- begin
- FImageIndex := Value;
- TAdvCustomGlowButton(FClient).Invalidate;
-
- if (csDesigning in FClient.ComponentState)
- {$IFDEF DELPHI2006_LVL}
- or not TAdvCustomGlowButton(FClient).StaticActionImageIndex
- {$ENDIF}
- then
- begin
- if TAdvCustomGlowButton(FClient).ActionHasImages then
- TAdvCustomGlowButton(FClient).ImageIndex := Value;
- end;
- end;
-end;
-
-//------------------------------------------------------------------------------
-
-function TAdvGlowButtonActionLink.IsImageIndexLinked: boolean;
-begin
- Result := inherited IsImageIndexLinked and
- (FImageIndex = (Action as TCustomAction).ImageIndex);
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvGlowButtonActionLink.SetChecked(Value: Boolean);
-begin
- if IsCheckedLinked then
- TAdvCustomGlowButton(FClient).Down := Value;
-end;
-
-//------------------------------------------------------------------------------
-
-procedure TAdvGlowButtonActionLink.SetGroupIndex(Value: Integer);
-begin
- if IsGroupIndexLinked then
- TAdvCustomGlowButton(FClient).GroupIndex := Value;
-end;
-
-{$ENDIF}
-
-{ TShortCutHintWindow }
-
-procedure TShortCutHintWindow.CreateParams(var Params: TCreateParams);
-const
- CS_DROPSHADOW = $00020000;
-begin
- inherited;
- Params.Style := Params.Style and not WS_BORDER;
- if (Win32Platform = VER_PLATFORM_WIN32_NT) and
- ((Win32MajorVersion > 5) or
- ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))) then
- if Params.WindowClass.Style and CS_DROPSHADOW <> 0 then
- Params.WindowClass.Style := Params.WindowClass.Style - CS_DROPSHADOW;
-end;
-
-procedure TShortCutHintWindow.Paint;
-var
- r: TRect;
-begin
- r := ClientRect;
- DrawGradient(Canvas, Color, ColorTo, 16, r, false);
- Canvas.Brush.Style := bsClear;
- Canvas.Font.Assign(self.Font);
-
- DrawText(Canvas.Handle,PChar(Caption),Length(Caption),r, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
-
- Canvas.Pen.Color := clGray;
- RoundRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom, 3,3);
-end;
-
-
-procedure TShortCutHintWindow.Resize;
-var
- ow: integer;
-begin
- inherited;
- ow := Canvas.TextWidth('O') + 8;
- if Width < ow then
- Width := ow;
-end;
-
-procedure TShortCutHintWindow.WMEraseBkGnd(var Message: TWMEraseBkGnd);
-begin
- Message.Result := 1;
-end;
-
-function TAdvCustomGlowButton.CanDrawBorder: Boolean;
-begin
- Result := (BorderStyle = bsSingle);
-end;
-
-function TAdvCustomGlowButton.CanDrawFocused: Boolean;
-begin
- Result := (FHasFocus) and (FocusType in [ftBorder, ftHotBorder]);
-end;
-
-{$IFDEF FREEWARE}
-{$I TRIAL.INC}
-{$ENDIF}
-
-
-
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advglowbuttondb.res b/TAdvTaskDialog/internal/1.5.1.2/1/Source/advglowbuttondb.res
deleted file mode 100644
index 5a25528..0000000
Binary files a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advglowbuttondb.res and /dev/null differ
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advhintinfo.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/advhintinfo.pas
deleted file mode 100644
index 72d2354..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advhintinfo.pas
+++ /dev/null
@@ -1,91 +0,0 @@
-{***************************************************************************}
-{ TAdvHintInfo component }
-{ for Delphi & C++Builder }
-{ }
-{ written by TMS Software }
-{ copyright © 2006 - 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 AdvHintInfo;
-
-interface
-
-uses
- Classes, GDIPicture;
-
-type
- TAdvHintInfo = class(TPersistent)
- private
- FPicture: TGDIPPicture;
- FShowHelp: boolean;
- FNotes: TStrings;
- FTitle: string;
- FWideTitle: widestring;
- FWideNotes: widestring;
- procedure SetNotes(const Value: TStrings);
- procedure SetPicture(const Value: TGDIPPicture);
- public
- constructor Create;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- property WideTitle: widestring read FWideTitle write FWideTitle;
- property WideNotes: widestring read FWideNotes write FWideNotes;
- published
- property Title: string read FTitle write FTitle;
- property Notes: TStrings read FNotes write SetNotes;
- property Picture: TGDIPPicture read FPicture write SetPicture;
- property ShowHelp: boolean read FShowHelp write FShowHelp default false;
- end;
-
-implementation
-
-{ TAdvHintInfo }
-
-procedure TAdvHintInfo.Assign(Source: TPersistent);
-begin
- if (Source is TAdvHintInfo) then
- begin
- Title := (Source as TAdvHintInfo).Title;
- Notes.Assign((Source as TAdvHintInfo).Notes);
- ShowHelp := (Source as TAdvHintInfo).ShowHelp;
- Picture.Assign((Source as TAdvHintInfo).Picture);
- WideTitle := (Source as TAdvHintInfo).WideTitle;
- WideNotes := (Source as TAdvHintInfo).WideNotes;
- end;
-end;
-
-constructor TAdvHintInfo.Create;
-begin
- inherited;
- FNotes := TStringList.Create;
- FPicture := TGDIPPicture.Create;
-end;
-
-destructor TAdvHintInfo.Destroy;
-begin
- FNotes.Free;
- FPicture.Free;
- inherited;
-end;
-
-procedure TAdvHintInfo.SetNotes(const Value: TStrings);
-begin
- FNotes.Assign(Value);
-end;
-
-procedure TAdvHintInfo.SetPicture(const Value: TGDIPPicture);
-begin
- FPicture.Assign(Value);
-end;
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advstyleif.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/advstyleif.pas
deleted file mode 100644
index e392d1e..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/advstyleif.pas
+++ /dev/null
@@ -1,63 +0,0 @@
-{***************************************************************************}
-{ TAdvStyleIF interface }
-{ for Delphi & C++Builder }
-{ version 1.0 }
-{ }
-{ written by TMS Software }
-{ copyright © 2006 }
-{ 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 AdvStyleIF;
-
-interface
-
-uses
- Classes;
-
-type
- TTMSStyle = (tsOffice2003Blue, tsOffice2003Silver, tsOffice2003Olive, tsOffice2003Classic,
- tsOffice2007Luna, tsOffice2007Obsidian, tsWindowsXP, tsWhidbey, tsCustom, tsOffice2007Silver);
-
- //
- // ['{E1199D64-5AF9-4DB7-B363-FABE5D1EEE0F}']
- // function GetComponentStyle: TTMSStyle;
-
- ITMSStyle = interface
- ['{11AC2DDC-C087-4298-AB6E-EA1B5017511B}']
- procedure SetComponentStyle(AStyle: TTMSStyle);
- end;
-
-function IsVista: boolean;
-
-implementation
-
-uses
- Windows;
-
-//------------------------------------------------------------------------------
-
-function IsVista: boolean;
-var
- hKernel32: HMODULE;
-begin
- hKernel32 := GetModuleHandle('kernel32');
- if (hKernel32 > 0) then
- begin
- Result := GetProcAddress(hKernel32, 'GetLocaleInfoEx') <> nil;
- end
- else
- Result := false;
-end;
-
-
-end.
diff --git a/TAdvTaskDialog/internal/1.5.1.2/1/Source/gdipicture.pas b/TAdvTaskDialog/internal/1.5.1.2/1/Source/gdipicture.pas
deleted file mode 100644
index 7cdbee7..0000000
--- a/TAdvTaskDialog/internal/1.5.1.2/1/Source/gdipicture.pas
+++ /dev/null
@@ -1,420 +0,0 @@
-{***************************************************************************}
-{ TGDIPPicture class }
-{ for Delphi & C++Builder }
-{ }
-{ written by TMS Software }
-{ copyright © 2006 - 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 GDIPicture;
-
-interface
-
-uses
- Windows, Classes, Graphics, Controls , SysUtils, AdvGDIP, ComObj, ActiveX;
-
-{$I TMSDEFS.INC}
-
-type
-
- TGDIPPicture = class(TGraphic)
- private
- { Private declarations }
- FDatastream: TMemoryStream;
- FIsEmpty: Boolean;
- FWidth, FHeight: Integer;
- FDoubleBuffered: Boolean;
- FBackgroundColor: TColor;
- FOnClear: TNotifyEvent;
- protected
- { Protected declarations }
- function GetEmpty: Boolean; override;
- function GetHeight: Integer; override;
- function GetWidth: Integer; override;
- procedure SetHeight(Value: Integer); override;
- procedure SetWidth(Value: Integer); override;
- procedure ReadData(Stream: TStream); override;
- procedure WriteData(Stream: TStream); override;
- public
- { Public declarations }
- constructor Create; override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- procedure DrawImage(Graphics: TGPGraphics; X,Y: integer);
- procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
- procedure LoadFromFile(const FileName: string); override;
- procedure LoadFromStream(Stream: TStream); override;
- procedure SaveToStream(Stream: TStream); override;
- procedure LoadFromResourceName(Instance: THandle; const ResName: String);
- procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
- procedure LoadFromURL(url:string);
- procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
- APalette: HPALETTE); override;
- procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
- var APalette: HPALETTE); override;
- property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered;
- property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
- function GetImageSizes: boolean;
- published
- { Published declarations }
- property OnClear: TNotifyEvent read FOnClear write FOnClear;
- end;
-
-
-implementation
-
-
-{ TGDIPPicture }
-
-procedure TGDIPPicture.Assign(Source: TPersistent);
-var
- st: TMemoryStream;
-begin
- FIsEmpty := True;
- if Source = nil then
- begin
- FDataStream.Clear;
- FIsEmpty := true;
- if Assigned(OnChange) then
- OnChange(Self);
- if Assigned(OnClear) then
- OnClear(self);
- end
- else
- begin
- if Source is TGDIPPicture then
- begin
- FDataStream.LoadFromStream(TGDIPPicture(Source).FDataStream);
- FIsEmpty := fdatastream.Size = 0;
- if Assigned(OnChange) then
- OnChange(self);
- end
- else
- if Source is TBitmap then
- begin
- st := TMemoryStream.Create;
- (Source as TBitmap).SaveToStream(st);
- st.Position := 0;
- FDataStream.LoadFromStream(st);
- st.Free;
- FIsEmpty := false;
- if Assigned(OnChange) then
- OnChange(self);
- end
- else
- if (Source is TPicture) then
- begin
- st := TMemoryStream.Create;
- (Source as TPicture).Graphic.SaveToStream(st);
- st.Position := 0;
- FDataStream.LoadFromStream(st);
- st.Free;
- FIsEmpty := false;
- if Assigned(OnChange) then
- OnChange(self);
- end;
-
- GetImageSizes;
- end;
-end;
-
-constructor TGDIPPicture.Create;
-begin
- inherited;
- FDataStream := TMemoryStream.Create;
- FIsEmpty := True;
-end;
-
-destructor TGDIPPicture.Destroy;
-begin
- FDataStream.Free;
- inherited;
-end;
-
-procedure TGDIPPicture.DrawImage(Graphics: TGPGraphics; X,Y: integer);
-var
- multi: TGPImage;
- pstm: IStream;
- hGlobal: THandle;
- pcbWrite: Longint;
-
-begin
- if Empty then
- Exit;
-
- if FDataStream.Size = 0 then
- Exit;
-
- hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
- if (hGlobal = 0) then
- raise Exception.Create('Could not allocate memory for image');
-
- try
- pstm := nil;
-
- // Create IStream* from global memory
- CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
- pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);
-
- multi := TGPImage.Create(pstm);
-
- graphics.DrawImage(multi, x,y);
-
- multi.Free;
-
- finally
- GlobalFree(hGlobal);
- end;
-end;
-
-procedure TGDIPPicture.Draw(ACanvas: TCanvas; const Rect: TRect);
-var
- dc: HDC;
- multi: TGPImage;
- graphic: TGPgraphics;
- pstm: IStream;
- hGlobal: THandle;
- pcbWrite: Longint;
- bmp: tbitmap;
-
-begin
- if Empty then
- Exit;
-
- if FDataStream.Size = 0 then
- Exit;
-
- hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
- if (hGlobal = 0) then
- raise Exception.Create('Could not allocate memory for image');
-
- try
- pstm := nil;
-
- // Create IStream* from global memory
- CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
- pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);
-
- dc := ACanvas.Handle;
- graphic:= TGPgraphics.Create(dc);
- multi := TGPImage.Create(pstm);
-
- if multi.GetFormat = ifBMP then
- begin // use this alternative for easy bitmap auto transparent drawing
- bmp := TBitmap.Create;
- FDataStream.Position := 0;
- bmp.LoadFromStream(FDataStream);
- bmp.TransparentMode := tmAuto;
- bmp.Transparent := true;
- ACanvas.Draw(Rect.Left,Rect.Top, bmp);
- bmp.Free;
- end
- else
- begin
- FWidth := multi.GetWidth;
- FHeight := multi.GetHeight;
- graphic.DrawImageRect(multi, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
- end;
-
- multi.Free;
- graphic.Free;
- finally
- GlobalFree(hGlobal);
- end;
-
-end;
-
-function TGDIPPicture.GetImageSizes: boolean;
-var
- multi: TGPImage;
- pstm: IStream;
- hGlobal: THandle;
- pcbWrite: Longint;
-
-begin
- Result := false;
-
- if Empty then
- Exit;
-
- if FDataStream.Size = 0 then
- Exit;
-
- hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
- if (hGlobal = 0) then
- raise Exception.Create('Could not allocate memory for image');
-
- try
- pstm := nil;
- // Create IStream* from global memory
- CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
- pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);
- multi := TGPImage.Create(pstm);
-
- FWidth := multi.GetWidth;
- FHeight := multi.GetHeight;
-
- Result := true;
-
- multi.Free;
- finally
- GlobalFree(hGlobal);
- end;
-
-end;
-
-function TGDIPPicture.GetEmpty: Boolean;
-begin
- Result := FIsEmpty;
-end;
-
-function TGDIPPicture.GetHeight: Integer;
-begin
- Result := FHeight;
-end;
-
-function TGDIPPicture.GetWidth: Integer;
-begin
- Result := FWidth;
-end;
-
-procedure TGDIPPicture.LoadFromFile(const FileName: string);
-begin
- try
- FDataStream.LoadFromFile(Filename);
-
- FIsEmpty := False;
-
- if Assigned(OnClear) then
- OnClear(self);
-
- GetImageSizes;
-
- if Assigned(OnChange) then
- OnChange(self);
-
-
- except
- FIsEmpty:=true;
- end;
-end;
-
-procedure TGDIPPicture.LoadFromStream(Stream: TStream);
-begin
- if Assigned(Stream) then
- begin
- FDataStream.LoadFromStream(Stream);
- FIsEmpty := False;
-
- GetImageSizes;
-
- if Assigned(OnChange) then
- OnChange(self);
- end;
-end;
-
-procedure TGDIPPicture.ReadData(Stream: TStream);
-begin
- if Assigned(Stream) then
- begin
- FDataStream.LoadFromStream(stream);
- FIsEmpty := False;
- end;
-end;
-
-procedure TGDIPPicture.SaveToStream(Stream: TStream);
-begin
- if Assigned(Stream) then
- FDataStream.SaveToStream(Stream);
-end;
-
-
-procedure TGDIPPicture.SetHeight(Value: Integer);
-begin
- {$IFDEF DELPHI6_LVL}
- inherited;
- {$ENDIF}
-end;
-
-procedure TGDIPPicture.SetWidth(Value: Integer);
-begin
- {$IFDEF DELPHI6_LVL}
- inherited;
- {$ENDIF}
-end;
-
-procedure TGDIPPicture.LoadFromResourceName(Instance: THandle; const ResName: string);
-var
- Stream: TCustomMemoryStream;
-begin
- if FindResource(Instance,PChar(ResName),RT_RCDATA) <> 0 then
- begin
- Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
- end;
-end;
-
-procedure TGDIPPicture.LoadFromResourceID(Instance: THandle; ResID: Integer);
-var
- Stream: TCustomMemoryStream;
-begin
- Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
- try
- LoadFromStream(Stream);
- finally
- Stream.Free;
- end;
-end;
-
-procedure TGDIPPicture.WriteData(Stream: TStream);
-begin
- if Assigned(Stream) then
- begin
- FDataStream.SaveToStream(stream);
- end;
-end;
-
-procedure TGDIPPicture.LoadFromURL(url: string);
-begin
- if (pos('RES://',UpperCase(url))=1) then
- begin
- Delete(url,1,6);
- if (url<>'') then
- LoadFromResourceName(hinstance,url);
- Exit;
- end;
-
- if (pos('FILE://',uppercase(url))=1) then
- begin
- Delete(url,1,7);
- if (url<>'')
- then LoadFromFile(url);
- end;
-end;
-
-procedure TGDIPPicture.LoadFromClipboardFormat(AFormat: Word;
- AData: THandle; APalette: HPALETTE);
-begin
-end;
-
-procedure TGDIPPicture.SaveToClipboardFormat(var AFormat: Word;
- var AData: THandle; var APalette: HPALETTE);
-begin
-end;
-
-
-end.