Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.012 c
3-82076
RDA
2003-09-06 12:00
2003.09.25
Скорректированный набор данных


1-82297
InspectorNET
2003-09-14 07:36
2003.09.25
Как отобразить в Label титль веб-страницы (показываемой webbrowse


1-82334
Neo_vr
2003-09-12 21:11
2003.09.25
Как сделать в Delphi чат со смайлами ???????????


3-82077
изм
2003-09-05 12:03
2003.09.25
База Access


14-82403
Karnegi
2003-09-04 12:26
2003.09.25
Помогите с филтрацией по двум критериям





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский