?? txbutton.pas
字號:
unit TXButton;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, JclGraphics, JclLogic;
type
TTButton = class(TCustomControl)
private
FCaption : TCaption;
FActive : Boolean;
FDowned : Boolean;
FFont : TFont;
FFocused : Boolean;
FModalResult : TModalResult;
FHotKey : Char;
FCancel : Boolean;
FDefault : Boolean;
FOnClick : TNotifyEvent;
FOnEnter : TNotifyEvent;
FOnExit : TNotifyEvent;
FOnKeyDown : TKeyEvent;
FOnKeyUp : TKeyEvent;
FOnKeyPress : TKeyPressEvent;
{ Slike }
FImgNSel : TPicture;
FImgSel : TPicture;
FDrawImgNEna : TBitmap;
FDrawImgNSel : TBitmap;
FDrawImgSel : TBitmap;
{ Da li je startovan }
FExecuted : Boolean;
procedure SetCaption (ACaption : TCaption);
function GetCaption : TCaption;
{ procedure SetDowned (ADowned : Boolean);
function GetDowned : Boolean;
}
procedure SetFont (AFont : TFont);
function GetFont : TFont;
procedure SetModalResult (AModalResult : TModalResult);
function GetModalResult : TModalResult;
procedure FOnButtonClick;
protected
procedure Paint; override;
procedure MouseEnter (var Message : TMessage); message CM_MOUSEENTER;
procedure MouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
procedure LMouseDown (var Message : TMessage); message WM_LBUTTONDOWN;
{
procedure RMouseDown (var Message : TMessage); message WM_RBUTTONDOWN;
}
procedure LMouseUp (var Message : TMessage); message WM_LBUTTONUP;
{
procedure RMouseUp (var Message : TMessage); message WM_RBUTTONUP;
}
procedure LMouseDblClick (var Message : TMessage); message WM_LBUTTONDBLCLK;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMLostFocus); message CM_EXIT;
procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TMessage); message WM_KEYUP;
procedure CMDialogChar(var Message : TCMDialogChar); message CM_DIALOGCHAR;
procedure CMDialogKey(var Message : TCMDialogKey); message CM_DIALOGKEY;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;
Procedure SetImgNSel(Pic:TPicture);
Procedure SetImgSel(Pic:TPicture);
public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
Procedure ImageResize;
{ Morhing }
{ procedure Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt);
procedure Blend;
}
published
property Caption : TCaption read GetCaption write SetCaption;
property Font : TFont read GetFont write SetFont;
property Enabled;
property ParentFont;
property Hint;
property ShowHint;
property TabOrder;
property TabStop;
property Cancel : Boolean read FCancel write FCancel default False;
property Default : Boolean read FDefault write FDefault default False;
property ModalResult : TModalResult read GetModalResult write SetModalResult default mrNone;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
property OnExit: TNotifyEvent read FOnExit write FOnExit;
property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
property ImageNSel: TPicture read FImgNSel write SetImgNSel;
property ImageSel: TPicture read FImgSel write SetImgSel;
end;
procedure Register;
implementation
{
Var
EBX, ESI, EDI, ESP, EBP,
FinA,
Dens1, Dens2 : Longint;
}
constructor TTButton.Create (AOwner : TComponent);
begin
Inherited Create (AOwner);
Width := 75;
Height := 25;
FFont := TFont.Create;
FCaption := 'XtraButton';
FActive := False;
FDowned := False;
FFocused := False;
TabStop := True;
FImgNSel := TPicture.Create;
FImgSel := TPicture.Create;
FDrawImgNSel := TBitmap.Create;
FDrawImgNEna := TBitmap.Create;
FDrawImgSel := TBitmap.Create;
{ StartUp Button }
{ FDrawImgNSel.Width := 4;
FDrawImgNSel.Height := 4;
{ FDrawImgNSel.Canvas.Pen.Color := clBlue;
FDrawImgNSel.Canvas.Rectangle(0,0,3,3);
FImgNSel.Bitmap.Assign(FDrawImgNSel);
FDrawImgNSel.Canvas.Pen.Color := clBlue;
FDrawImgNSel.Canvas.Rectangle(1,1,4,4);
FImgSel.Bitmap.Assign(FDrawImgNSel);
FDrawImgNSel.FreeImage;
}
FExecuted := False;
Enabled := True;
end;
destructor TTButton.Destroy;
begin
FImgNSel.Free;
FImgSel.Free;
FDrawImgNSel.Free;
FDrawImgNEna.Free;
FDrawImgSel.Free;
FFont.Free;
inherited;
end;
procedure TTButton.CMDialogKey(var Message : TCMDialogKey);
begin
if Enabled and ((FCancel and (Message.CharCode = VK_ESCAPE)) or
(FDefault and (Message.CharCode = VK_RETURN))) then
FOnButtonClick;
end;
procedure Grayscale(const Bmp: TBitmap);
{From: Pascal Enz, pascal.enz@datacomm.ch }
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;
var
x, y, Gray: Integer;
Row: PRGBArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.ScanLine[y];
for x := 0 to Bmp.Width - 1 do
begin
Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
Row[x].rgbtRed := Gray;
Row[x].rgbtGreen := Gray;
Row[x].rgbtBlue := Gray;
end;
end;
end;
{procedure Antialising(C: TCanvas; Rect: TRect; Percent: Integer);
var
l, p: Integer;
R, G, B: Integer;
R1, R2, G1, G2, B1, B2: Byte;
begin
with c do
begin
Brush.Style := bsclear;
{ lineto(200, 100);
moveto(50, 150);
Ellipse(50, 150, 200, 30);}
{ for l := Rect.Top to Rect.Bottom do
begin
for p := Rect.Left to Rect.Right do
begin
R1 := GetRValue(Pixels[p, l]);
G1 := GetGValue(Pixels[p, l]);
B1 := GetBValue(Pixels[p, l]);
//Pixel links
//Pixel left
R2 := GetRValue(Pixels[p - 1, l]);
G2 := GetGValue(Pixels[p - 1, l]);
B2 := GetBValue(Pixels[p - 1, l]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p - 1, l] := RGB(R, G, B);
end;
//Pixel rechts
//Pixel right
R2 := GetRValue(Pixels[p + 1, l]);
G2 := GetGValue(Pixels[p + 1, l]);
B2 := GetBValue(Pixels[p + 1, l]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p + 1, l] := RGB(R, G, B);
end;
//Pixel oben
//Pixel up
R2 := GetRValue(Pixels[p, l - 1]);
G2 := GetGValue(Pixels[p, l - 1]);
B2 := GetBValue(Pixels[p, l - 1]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p, l - 1] := RGB(R, G, B);
end;
//Pixel unten
//Pixel down
R2 := GetRValue(Pixels[p, l + 1]);
G2 := GetGValue(Pixels[p, l + 1]);
B2 := GetBValue(Pixels[p, l + 1]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p, l + 1] := RGB(R, G, B);
end;
end;
end;
end;
end;
}
procedure AntiAliasing(clip: tbitmap; XOrigin, YOrigin,
XFinal, YFinal: Integer);
var Memo,x,y: Integer; (* Composantes primaires des points environnants *)
p0,p1,p2:pbytearray;
begin
if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end; (* Inversion des valeurs *)
if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end; (* si diff俽ence n俫ative*)
XOrigin:=max(1,XOrigin);
YOrigin:=max(1,YOrigin);
XFinal:=min(clip.width-2,XFinal);
YFinal:=min(clip.height-2,YFinal);
clip.PixelFormat :=pf24bit;
for y := YOrigin to YFinal do begin
p0:=clip.ScanLine [y-1];
p1:=clip.ScanLine [y];
p2:=clip.ScanLine [y+1];
for x := XOrigin to XFinal do
Begin
p1[x*3] := (p0[x*3]+p2[x*3]+p1[x*3]*4) div 6;
p1[x*3+1] := (p0[x*3+1]+p2[x*3+1]+p1[x*3+1]*4) div 6;
p1[x*3+2] := (p0[x*3+2]+p2[x*3+2]+p1[x*3+2]*4) div 6;
end;
end;
end;
Procedure TTButton.ImageResize;
var
W, H, T : Integer;
tR, tR1 : TRect;
tBMP : TBitmap;
AText : String;
Begin
AText := FCaption;
If Pos ('&', FCaption) <> 0 then Delete (AText, Pos ('&', AText), 1);
W := FImgSel.Width;
H := FImgSel.Height;
tBMP := TBitmap.Create;
tBMP.Assign( FImgSel.Graphic );
FDrawImgSel.Width := Width;
FDrawImgSel.Height := Height;
FDrawImgSel.Canvas.CopyMode := cmSrcCopy;
{ Pocetak Gore Levo }
{ Source }
tR.Top := 0;
tR.Bottom := H;
tR.Left := 0;
tR.Right := W;
{ Destinaction }
tR1 := tR;
FDrawImgSel.Canvas.CopyRect(tR1, tBMP.Canvas, tR);
{ Dole Levo }
{ Source }
tR.Top := Trunc(H/2);
tR.Bottom := H;
tR.Left := 0;
tR.Right := W;
{ Destinaction }
tR1.Top := Height+tR.Top-tR.Bottom;
tR1.Bottom := Height;
tR1.Left := 0;
tR1.Right := W;
FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);
{ Levo razvlacenje }
{ Source }
tR.Top := Trunc(H/2)-1;
tR.Bottom := Trunc(H/2);
tR.Left := 0;
tR.Right := W;
For T := Trunc(H/2)-1 to Height-Trunc(H/2) Do
Begin
{ Destinaction }
tR1.Top := T;
tR1.Bottom := T+1;
tR1.Left := 0;
tR1.Right := W;
FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);
End;
{ Desna Ivica }
{ Source }
tR.Top := 0;
tR.Bottom := Height;
tR.Left := Trunc(W/2);
tR.Right := W;
{ Destinaction }
tR1.Top := 0;
tR1.Bottom := Height;
tR1.Left := Width+tR.Left-tR.Right;
tR1.Right := Width;
FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);
{ Desno razvlacenje }
{ Source }
tR.Top := 0;
tR.Bottom := Height;
tR.Left := Trunc(W/2)-1;
tR.Right := Trunc(W/2);
For T := Trunc(W/2)-1 to Width-Trunc(W/2) do
Begin
{ Destinaction }
tR1.Top := 0;
tR1.Bottom := Height;
tR1.Left := T;
tR1.Right := T+1;
FDrawImgSel.Canvas.CopyRect(tR1, FDrawImgSel.Canvas, tR);
End;
{ Caption }
FDrawImgSel.Canvas.Font := FFont;
FDrawImgSel.Canvas.Brush.Style := bsClear;
FDrawImgSel.Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
(Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2 + Integer (FDowned),
(Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2 + Integer (FDowned), AText);
If Pos ('&', FCaption) <> 0 then
begin
FDrawImgSel.Canvas.Pen.Color := FDrawImgSel.Canvas.Font.Color;
FDrawImgSel.Canvas.Pen.Width := 1;
FDrawImgSel.Canvas.MoveTo (((Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2) + FDrawImgSel.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption)-1)) + Integer (FDowned),
((Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2) + FDrawImgSel.Canvas.TextHeight (AText) + Integer (FDowned));
FDrawImgSel.Canvas.LineTo (((Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2) + FDrawImgSel.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption))) + Integer (FDowned),
((Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2) + FDrawImgSel.Canvas.TextHeight (AText) + Integer (FDowned));
end;
Antialiasing(FDrawImgSel, (Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2,
(Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2,
Width-((Width - FDrawImgSel.Canvas.TextWidth (AText)) div 2),
Height-((Height - FDrawImgSel.Canvas.TextHeight (AText)) div 2 ) );
{ ****** Not Sel ******** }
tBMP.FreeImage;
tBMP.Assign( FImgNSel.Graphic );
FDrawImgNSel.Width := Width;
FDrawImgNSel.Height := Height;
FDrawImgNSel.Canvas.CopyMode := cmSrcCopy;
{ Pocetak Gore Levo }
{ Source }
tR.Top := 0;
tR.Bottom := H;
tR.Left := 0;
tR.Right := W;
{ Destinaction }
tR1 := tR;
FDrawImgNSel.Canvas.CopyRect(tR1, tBMP.Canvas, tR);
{ Dole Levo }
{ Source }
tR.Top := Trunc(H/2);
tR.Bottom := H;
tR.Left := 0;
tR.Right := W;
{ Destinaction }
tR1.Top := Height+tR.Top-tR.Bottom;
tR1.Bottom := Height;
tR1.Left := 0;
tR1.Right := W;
FDrawImgNSel.Canvas.CopyRect(tR1, FDrawImgNSel.Canvas, tR);
{ Levo razvlacenje }
{ Source }
tR.Top := Trunc(H/2)-1;
tR.Bottom := Trunc(H/2);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -