- Se quitan unidades que sobran.
- Se traducen botones al castellano. git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TMSSoftware@12 ccf39c52-e665-a648-be6a-52d81bcb5567
This commit is contained in:
parent
c491ee6970
commit
25b0ff104d
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/SpanishContst.dcu
Normal file
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/SpanishContst.dcu
Normal file
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.bpl
Normal file
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.bpl
Normal file
Binary file not shown.
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcp
Normal file
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcp
Normal file
Binary file not shown.
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcu
Normal file
BIN
TAdvTaskDialog/internal/1.5.1.2/1/Lib/D12/TaskDialogPkg.dcu
Normal file
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -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.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@ -1,48 +0,0 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{79C894D4-A16D-4924-81DC-BB8F72238C44}</ProjectGuid>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Projects Include="TaskDialogPkgD2009R.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
<Projects Include="TaskDialogPkgD2009D.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Default.Personality/>
|
||||
</BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Target Name="TaskDialogPkgD2009R">
|
||||
<MSBuild Projects="TaskDialogPkgD2009R.dproj"/>
|
||||
</Target>
|
||||
<Target Name="TaskDialogPkgD2009R:Clean">
|
||||
<MSBuild Targets="Clean" Projects="TaskDialogPkgD2009R.dproj"/>
|
||||
</Target>
|
||||
<Target Name="TaskDialogPkgD2009R:Make">
|
||||
<MSBuild Targets="Make" Projects="TaskDialogPkgD2009R.dproj"/>
|
||||
</Target>
|
||||
<Target Name="TaskDialogPkgD2009D">
|
||||
<MSBuild Projects="TaskDialogPkgD2009D.dproj"/>
|
||||
</Target>
|
||||
<Target Name="TaskDialogPkgD2009D:Clean">
|
||||
<MSBuild Targets="Clean" Projects="TaskDialogPkgD2009D.dproj"/>
|
||||
</Target>
|
||||
<Target Name="TaskDialogPkgD2009D:Make">
|
||||
<MSBuild Targets="Make" Projects="TaskDialogPkgD2009D.dproj"/>
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="TaskDialogPkgD2009R;TaskDialogPkgD2009D"/>
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="TaskDialogPkgD2009R:Clean;TaskDialogPkgD2009D:Clean"/>
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="TaskDialogPkgD2009R:Make;TaskDialogPkgD2009D:Make"/>
|
||||
</Target>
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
|
||||
</Project>
|
||||
21
TAdvTaskDialog/internal/1.5.1.2/1/Source/SpanishContst.pas
Normal file
21
TAdvTaskDialog/internal/1.5.1.2/1/Source/SpanishContst.pas
Normal file
@ -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.
|
||||
@ -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}
|
||||
|
||||
@ -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.
|
||||
@ -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.
|
||||
@ -1,7 +1,7 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{322e4f51-9fd5-43be-8659-42e8edcc60b1}</ProjectGuid>
|
||||
<MainSource>TaskDialogPkgD2009D.dpk</MainSource>
|
||||
<MainSource>TaskDialogPkg.dpk</MainSource>
|
||||
<Configuration Condition=" '$(Configuration)' == '' ">Release</Configuration>
|
||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
@ -13,8 +13,7 @@
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<DCC_UnitSearchPath>..\Lib\D12;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
|
||||
<DCC_DependencyCheckOutputName>..\Lib\D12\TaskDialogPkgD2009D.bpl</DCC_DependencyCheckOutputName>
|
||||
<DCC_DependencyCheckOutputName>..\Lib\D12\TaskDialogPkg.bpl</DCC_DependencyCheckOutputName>
|
||||
<DCC_ImageBase>00400000</DCC_ImageBase>
|
||||
<DesignOnlyPackage>false</DesignOnlyPackage>
|
||||
<DCC_BplOutput>..\Lib\D12</DCC_BplOutput>
|
||||
@ -66,23 +65,24 @@
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
<Source>
|
||||
<Source Name="MainSource">TaskDialogPkgD2009D.dpk</Source>
|
||||
<Source Name="MainSource">TaskDialogPkg.dpk</Source>
|
||||
</Source>
|
||||
</Delphi.Personality>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="TaskDialogPkgD2009D.dpk">
|
||||
<DelphiCompile Include="TaskDialogPkg.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="rtl.dcp"/>
|
||||
<DCCReference Include="vcl.dcp"/>
|
||||
<DCCReference Include="designide.dcp"/>
|
||||
<DCCReference Include="dbrtl.dcp"/>
|
||||
<DCCReference Include="vcldb.dcp"/>
|
||||
<DCCReference Include="TaskDialogRegDE.pas"/>
|
||||
<DCCReference Include="TaskDialogEx.pas"/>
|
||||
<DCCReference Include="SpanishContst.pas"/>
|
||||
<DCCReference Include="TaskDialog.pas"/>
|
||||
<DCCReference Include="TaskDialogDE.pas"/>
|
||||
<DCCReference Include="picturecontainer.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
@ -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.
|
||||
@ -1,98 +0,0 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{322e4f51-9fd5-43be-8659-42e8edcc60b1}</ProjectGuid>
|
||||
<MainSource>TaskDialogPkgD2009R.dpk</MainSource>
|
||||
<Configuration Condition=" '$(Configuration)' == '' ">Release</Configuration>
|
||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
<DCC_DependencyCheckOutputName>..\Lib\D11\TaskDialogPkgD2007.bpl</DCC_DependencyCheckOutputName>
|
||||
<ProjectVersion>12.0</ProjectVersion>
|
||||
<Config Condition="'$(Config)'==''">Base</Config>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<DCC_DependencyCheckOutputName>..\Lib\D12\TaskDialogPkgD2009R.bpl</DCC_DependencyCheckOutputName>
|
||||
<DCC_ImageBase>00400000</DCC_ImageBase>
|
||||
<DesignOnlyPackage>false</DesignOnlyPackage>
|
||||
<DCC_BplOutput>..\Lib\D12</DCC_BplOutput>
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
<DCC_Description>TMS TaskDialog</DCC_Description>
|
||||
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||
<DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
|
||||
<DCC_DcpOutput>..\Lib\D12</DCC_DcpOutput>
|
||||
<GenDll>true</GenDll>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<GenPackage>true</GenPackage>
|
||||
<DCC_DcuOutput>..\Lib\D12</DCC_DcuOutput>
|
||||
</PropertyGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<Parameters>
|
||||
<Parameters Name="UseLauncher">False</Parameters>
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">0</VersionInfo>
|
||||
<VersionInfo Name="Build">0</VersionInfo>
|
||||
<VersionInfo Name="Debug">False</VersionInfo>
|
||||
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||
<VersionInfo Name="Special">False</VersionInfo>
|
||||
<VersionInfo Name="Private">False</VersionInfo>
|
||||
<VersionInfo Name="DLL">False</VersionInfo>
|
||||
<VersionInfo Name="Locale">2067</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"/>
|
||||
<VersionInfoKeys Name="FileDescription"/>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"/>
|
||||
<VersionInfoKeys Name="LegalCopyright"/>
|
||||
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||
<VersionInfoKeys Name="OriginalFilename"/>
|
||||
<VersionInfoKeys Name="ProductName"/>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
<Source>
|
||||
<Source Name="MainSource">TaskDialogPkgD2009R.dpk</Source>
|
||||
</Source>
|
||||
</Delphi.Personality>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="TaskDialogPkgD2009R.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="rtl.dcp"/>
|
||||
<DCCReference Include="vcl.dcp"/>
|
||||
<DCCReference Include="designide.dcp"/>
|
||||
<DCCReference Include="dbrtl.dcp"/>
|
||||
<DCCReference Include="vcldb.dcp"/>
|
||||
<DCCReference Include="TaskDialog.pas"/>
|
||||
<DCCReference Include="PictureContainer.pas"/>
|
||||
<DCCReference Include="TaskDialogDE.pas"/>
|
||||
<DCCReference Include="advgdip.pas"/>
|
||||
<DCCReference Include="advglowbutton.pas"/>
|
||||
<DCCReference Include="AdvGroupBox.pas"/>
|
||||
<DCCReference Include="advhintinfo.pas"/>
|
||||
<DCCReference Include="AdvOfficeButtons.pas"/>
|
||||
<DCCReference Include="advstyleif.pas"/>
|
||||
<DCCReference Include="gdipicture.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
|
||||
</Project>
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@ -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.
|
||||
@ -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.
|
||||
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user