Форум: "Основная";
Текущий архив: 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.011 c