Форум: "Основная";
Текущий архив: 2003.09.25;
Скачать: [xml.tar.bz2];
ВнизTOffice97Button Найти похожие ветки
← →
SomeBody (2003-09-13 17:04) [0]Скажите, где достать компонент TOffice97Button? Очень надо!
← →
dataMaster (2003-09-13 17:20) [1]
{ TOButton component version 1.0, copyright © A. Meeder, 1996
** It"s freeware, so you don"t have to pay me, but I do not guarantee the working of it
The idea came from the personal assistent of MS Office 97. To use this component:
Drop the component on your form and position it where you want to have it.
This are the special properties:
* BorderColor, color of the border when the button has the mouse
* BorderWidth, basic width of the border (1 .. 3)
* DownGlyph, LED-bitmap when the button is down, you can use your own bitmap
* OffGlyph, LED-bitmap when the mouse is not over the button, you can use your own bitmap
* OnGlyph, LED-bitmap when the mouse is over the button, you can use your own bitmap
* RoundSize, used to change the corners of the button
* TransParentcolor, color of the LED-bitmaps to make transparent
If you have suggestions about TOButton or make changes, please mail me: ameeder@dds.nl
}
unit OButton;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TBorderWidth = 1..3;
TOfficeButton = class(TGraphicControl)
private
{ Private declarations }
FRoundSize: integer;
FCaption: TCaption;
FDownGlyph: TBitmap;
FOffGlyph: TBitmap;
FOnGlyph: TBitmap;
FBorderColor: TColor;
FBorderWidth: TBorderWidth;
FFont: TFont;
FTransparentColor: TColor;
HasMouse: boolean;
IsMouseDown: boolean;
ExtraSpace: word;
procedure SetBorderColor(value: TColor);
procedure SetBorderWidth(value: TBorderWidth);
procedure SetDownGlyph(value: TBitmap);
procedure SetOffGlyph(value: TBitmap);
procedure SetOnGlyph(value: TBitmap);
procedure SetCaption(value: TCaption);
procedure SetFont(value: TFont);
procedure SetRoundSize(value: integer);
procedure SetTransparentColor(value: TColor);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; // New event
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; // New event
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Caption: TCaption read FCaption write SetCaption;
property BorderColor: TColor read FBorderColor write FBorderColor default clGray;
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 1;
property DownGlyph: TBitmap read FDownGlyph write SetDownGlyph;
property Font: TFont read FFont write SetFont;
property OffGlyph: TBitmap read FOffGlyph write SetOffGlyph;
property OnGlyph: TBitmap read FOnGlyph write SetOnGlyph;
property RoundSize: integer read FRoundSize write SetRoundSize default 15;
property TransparentColor: TColor read FTransparentColor write SetTransparentColor default clWhite;
property Color;
property Enabled;
property ShowHint;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
{$R OBBITMAP.RES}
procedure TOfficeButton.SetBorderColor(value: TColor);
begin
if Value <> FBorderColor then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TOfficeButton.SetBorderWidth(value: TBorderWidth);
begin
if Value <> FBorderWidth then
begin
FBorderWidth := Value;
Invalidate;
end;
end;
procedure TOfficeButton.SetCaption(value: TCaption);
begin
if Value <> FCaption then
begin
FCaption := Value;
Invalidate;
end;
end;
procedure TOfficeButton.SetFont(value: TFont);
begin
if Value <> FFont then
begin
FFont.Assign(Value);
Invalidate;
end;
end;
← →
dataMaster (2003-09-13 17:21) [2]продолжение...
procedure TOfficeButton.SetDownGlyph(value: TBitmap);
begin
FDownGlyph.Assign(value);
Invalidate;
end;
procedure TOfficeButton.SetOffGlyph(value: TBitmap);
begin
FOffGlyph.Assign(value);
Invalidate;
end;
procedure TOfficeButton.SetOnGlyph(value: TBitmap);
begin
FOnGlyph.Assign(value);
Invalidate;
end;
procedure TOfficeButton.SetRoundSize(value: integer);
begin
if Value <> FRoundSize then
begin
FRoundSize := Value;
Invalidate;
end;
end;
procedure TOfficeButton.SetTransparentColor(value: TColor);
begin
if Value <> FTransparentColor then
begin
FTransparentColor := value;
Invalidate;
end;
end;
procedure TOfficeButton.CMMouseEnter(var Message: TMessage);
begin
HasMouse := true;
if IsMouseDown then ExtraSpace := 1 else ExtraSpace := 0;
Invalidate;
end;
procedure TOfficeButton.CMMouseLeave(var Message: TMessage);
begin
HasMouse := false;
ExtraSpace := 0;
Invalidate;
end;
procedure TOfficeButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown := true;
ExtraSpace := 1;
Invalidate;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TOfficeButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown := false;
ExtraSpace := 0;
Invalidate;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TOfficeButton.Paint;
var
GlyphRect, BitmapRect: TRect;
GlyphTop, GlyphLeft: integer;
begin
GlyphTop := ((Height - FOffGlyph.Height) div 2) + ExtraSpace;
GlyphLeft := 7 + ExtraSpace;
GlyphRect := Rect(GlyphLeft, GlyphTop, FOffGlyph.Width+GlyphLeft, FOffGlyph.Height+GlyphTop);
BitmapRect := Rect(0, 0, FOffGlyph.Width, FOffGlyph.Height);
with Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := Color;
Font.Assign(FFont);
if HasMouse then
begin
Pen.Color := BorderColor;
Pen.Width := BorderWidth+1;
RoundRect(BorderWidth,BorderWidth,Width-(BorderWidth-1),Height-(BorderWidth-1),FRoundSize,FRoundSize);
Pen.Color := clWhite;
Pen.Width := 2;
MoveTo(FRoundSize div 2, BorderWidth+2);
LineTo(Width - (FRoundSize div 2), BorderWidth+2);
end
else
begin
Pen.Color := clSilver;
Pen.Width := BorderWidth;
RoundRect(BorderWidth-1,BorderWidth-1,Width-(BorderWidth-1),Height-(BorderWidth-1),FRoundSize,FRoundSize);
end;
if HasMouse then
if IsMouseDown then
BrushCopy(GlyphRect, FDownGlyph, BitmapRect, FTransparentColor)
else
BrushCopy(GlyphRect, FOnGlyph, BitmapRect, FTransparentColor)
else
BrushCopy(GlyphRect, FOffGlyph, BitmapRect, FTransparentColor);
TextOut(((Width - TextWidth(FCaption)) div 2)+ GlyphLeft,((Height - TextHeight(FCaption)) div 2)+ExtraSpace,FCaption);
end;
end;
constructor TOfficeButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFont := TFont.Create;
Width := 100;
Height := 25;
FCaption := "OfficeButton";
FDownGlyph := TBitmap.Create;
FOffGlyph := TBitmap.Create;
FOnGlyph := TBitmap.Create;
FDownGlyph.Handle := LoadBitmap(HInstance, "DOWN");
FOffGlyph.Handle := LoadBitmap(HInstance, "OFF");
FOnGlyph.Handle := LoadBitmap(HInstance, "ON");
FRoundSize := 20;
Color := $00C8FFFF;
TransparentColor := clWhite;
HasMouse := false;
IsMouseDown := false;
ExtraSpace := 0;
FBorderColor := clGray;
FBorderWidth := 1;
FFont.Name := "Arial";
FFont.Size := 8;
end;
destructor TOfficeButton.Destroy;
begin
FFont.Free;
FDownGlyph.Free;
FOffGlyph.Free;
FOnGlyph.Free;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents("AM Software", [TOfficeButton]);
end;
end.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2003.09.25;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.009 c