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;

продолжение...

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.

TOffice97Button Найти похожие ветки