?? txbutton.pas
字號:
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;
FDrawImgNSel.Canvas.CopyRect(tR1, FDrawImgNSel.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;
FDrawImgNSel.Canvas.CopyRect(tR1, FDrawImgNSel.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;
FDrawImgNSel.Canvas.CopyRect(tR1, FDrawImgNSel.Canvas, tR);
End;
{ Caption NSEl }
FDrawImgNSel.Canvas.Font := FFont;
FDrawImgNSel.Canvas.Brush.Style := bsClear;
FDrawImgNSel.Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
(Width - FDrawImgNSel.Canvas.TextWidth (AText)) div 2 + Integer (FDowned),
(Height - FDrawImgNSel.Canvas.TextHeight (AText)) div 2 + Integer (FDowned), AText);
If Pos ('&', FCaption) <> 0 then
begin
FDrawImgNSel.Canvas.Pen.Color := FDrawImgNSel.Canvas.Font.Color;
FDrawImgNSel.Canvas.Pen.Width := 1;
FDrawImgNSel.Canvas.MoveTo (((Width - FDrawImgNSel.Canvas.TextWidth (AText)) div 2) + FDrawImgNSel.Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption)-1)) + Integer (FDowned),
((Height - FDrawImgNSel.Canvas.TextHeight (AText)) div 2) + FDrawImgNSel.Canvas.TextHeight (AText) + Integer (FDowned));
FDrawImgNSel.Canvas.LineTo (((Width - FDrawImgNSel.Canvas.TextWidth (AText)) div 2) + Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption))) + Integer (FDowned),
((Height - FDrawImgNSel.Canvas.TextHeight (AText)) div 2) + FDrawImgNSel.Canvas.TextHeight (AText) + Integer (FDowned));
end;
Antialiasing(FDrawImgNSel, (Width - FDrawImgNSel.Canvas.TextWidth (AText)) div 2,
(Height - FDrawImgNSel.Canvas.TextHeight (AText)) div 2,
Width-((Width - FDrawImgNSel.Canvas.TextWidth (AText)) div 2),
Height-((Height - FDrawImgNSel.Canvas.TextHeight (AText)) div 2 ) );
FDrawImgNEna.Assign( FDrawImgNSel );
GrayScale( FDrawImgNEna );
End;
procedure TTButton.Paint;
begin
{
AText := FCaption;
If Pos ('&', FCaption) <> 0 then Delete (AText, Pos ('&', AText), 1);
}
If (FDrawImgSel.Height <> Height) or
(FDrawImgSel.Width <> Width) Then
ImageResize;
Canvas.Brush.Style := bsClear;
{ Canvas.Font := FFont;}
If Enabled Then
Begin
If FDowned then
begin
Canvas.CopyMode := cmNotSrcCopy;
Canvas.Draw(0, 0, FDrawImgSel );
end
else If FFocused or FExecuted then
begin
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, FDrawImgSel );
end
else
begin
Canvas.CopyMode := cmSrcCopy;
Canvas.Draw(0, 0, FDrawImgNSel );
End;
End
Else
Begin
Canvas.Draw(0, 0, FDrawImgNEna );
{ Canvas.Font.Color := RGB (161, 161, 146);}
End;
{ Canvas.TextRect (Rect (4, 4, Width-4, Height-4),
(Width - Canvas.TextWidth (AText)) div 2 + Integer (FDowned),
(Height - Canvas.TextHeight (AText)) div 2 + Integer (FDowned), AText);
if Pos ('&', FCaption) <> 0 then
begin
Canvas.Pen.Color := Canvas.Font.Color;
Canvas.Pen.Width := 1;
Canvas.MoveTo (((Width - Canvas.TextWidth (AText)) div 2) + Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption)-1)) + Integer (FDowned),
((Height - Canvas.TextHeight (AText)) div 2) + Canvas.TextHeight (AText) + Integer (FDowned));
Canvas.LineTo (((Width - Canvas.TextWidth (AText)) div 2) + Canvas.TextWidth (Copy (AText, 1, Pos ('&', FCaption))) + Integer (FDowned),
((Height - Canvas.TextHeight (AText)) div 2) + Canvas.TextHeight (AText) + Integer (FDowned));
end;
}
Canvas.Brush.Style := bsClear;
end;
procedure TTButton.MouseEnter (var Message : TMessage);
begin
If Enabled and (not FFocused) Then
Begin
Try
SetFocus;
Paint;
except
end;
End;
end;
procedure TTButton.MouseLeave (var Message : TMessage);
begin
If Enabled Then
Begin
FFocused := False;
Paint;
End;
end;
procedure TTButton.SetCaption (ACaption : TCaption);
begin
if FCaption <> ACaption then
Begin
FCaption := ACaption;
if (Pos ('&', FCaption) <> 0) and (Pos ('&', FCaption) < Length (FCaption)) then
FHotKey := UpperCase (String (Copy (FCaption, Pos ('&', FCaption)+1, 1)))[1]
else
FHotKey := #0;
{ ImageResize;}
Repaint;
end;
end;
function TTButton.GetCaption : TCaption;
begin
Result := FCaption;
end;
{procedure TTButton.SetDowned (ADowned : Boolean);
begin
if FDowned <> ADowned then
Begin
FDowned := ADowned;
Repaint;
end;
end;
function TTButton.GetDowned : Boolean;
begin
Result := FDowned;
end;
}
procedure TTButton.SetFont (AFont : TFont);
begin
FFont.Assign (AFont);
RePaint;
end;
function TTButton.GetFont : TFont;
begin
Result := FFont;
end;
procedure TTButton.LMouseDblClick (var Message : TMessage);
begin
FOnButtonClick;
end;
procedure TTButton.LMouseDown (var Message : TMessage);
begin
if not FDowned then
begin
FDowned := true;
if (not Focused) and (Enabled) then SetFocus;
Repaint;
end;
end;
{
procedure TTButton.RMouseDown (var Message : TMessage);
begin
end;
}
procedure TTButton.LMouseUp (var Message : TMessage);
begin
if FDowned then
begin
FDowned := False;
Repaint;
FOnButtonClick;
end;
end;
{
procedure TTButton.RMouseUp (var Message : TMessage);
begin
end;
}
procedure TTButton.CMEnter(var Message: TCMGotFocus);
begin
inherited;
if Assigned (FOnEnter) then FOnEnter (self);
end;
procedure TTButton.CMExit(var Message: TCMLostFocus);
begin
inherited;
if Assigned (FOnExit) then FOnExit (self);
end;
procedure TTButton.WMSetFocus(var Message: TMessage);
begin
{ Blend;}
if Enabled and (not FFocused) then
begin
FFocused := true;
Invalidate;
end;
end;
procedure TTButton.WMKillFocus(var Message: TMessage);
begin
if FFocused then
begin
FFocused := False;
Invalidate;
end;
end;
procedure TTButton.WMKeyDown (var Message: TMessage);
begin
if (not FDowned) and ((Message.WParam = VK_RETURN) or (Message.WParam = VK_SPACE)) then
Begin
FDowned := true;
Invalidate;
end;
inherited;
end;
procedure TTButton.WMKeyUp (var Message: TMessage);
Begin
if FDowned then
begin
FDowned := False;
Invalidate;
FOnButtonClick;
end;
inherited;
end;
procedure TTButton.SetModalResult (AModalResult : TModalResult);
begin
FModalResult := AModalResult;
end;
function TTButton.GetModalResult : TModalResult;
begin
Result := FModalResult;
end;
procedure TTButton.FOnButtonClick;
begin
If Enabled Then
Begin
if (not Focused) and (Enabled) then SetFocus;
If not FExecuted Then FExecuted := True;
RePaint;
If Assigned (FOnClick) then
Begin
FOnClick (Self);
End;
If (FModalResult <> mrNone) and (Owner.InheritsFrom (TCustomForm)) then
(Owner as TCustomForm).ModalResult := FModalResult;
FExecuted := False;
End;
end;
procedure TTButton.CMDialogChar(var Message : TCMDialogChar);
begin
if Enabled and IsAccel (Message.CharCode, FCaption) then
FOnButtonClick;
end;
Procedure TTButton.SetImgNSel(Pic:TPicture);
Begin
FImgNSel.Assign(Pic);
{ FDrawImgNSel.Ass := FImgNSel.Bitmap;}
End;
Procedure TTButton.SetImgSel(Pic:TPicture);
Begin
FImgSel.Assign(Pic);
If (FDrawImgSel.Height <> Height) or
(FDrawImgSel.Width <> Width) Then
ImageResize;
{ FDrawImgSel := FImgSel.Bitmap;}
End;
procedure TTButton.CMEnabledChanged(var Message: TMessage);
begin
inherited;
invalidate;
{ Paint;}
end;
procedure TTButton.WMEraseBkgnd(var m : TWMEraseBkgnd);
begin
m.Result := LRESULT(False);
end;
{
Function Pt(B : TBitmap) : Pointer;
Begin
Pt := B.Scanline[(B.Height-1)]
End;
{
procedure TTButton.Blendit(bFr,bTo,bLn : Pointer ; Width,Height : Integer ; Dens : LongInt); assembler;
ASM
MOV &EDI, EDI
MOV &ESI, ESI
MOV &ESP, ESP
MOV &EBP, EBP
MOV EBX, Dens
MOV Dens1, EBX
NEG BL
ADD BL, $20
MOV Dens2, EBX
CMP Dens1, 0
JZ @Final
MOV EDI, bFr
MOV ESI, bTo
MOV ECX, bLn
MOV EAX, Width
lea EAX, [EAX+EAX*2+3]
AND EAX, $FFFFFFFC
IMUL Height
ADD EAX, EDI
MOV FinA, EAX
MOV EBP,EDI
MOV ESP,ESI
MOV ECX,ECX
@LOOPA:
MOV EAX, [EBP]
MOV EDI, [ESP]
MOV EBX, EAX
AND EAX, Mask1010
AND EBX, Mask0101
SHR EAX, 5
IMUL EAX, Dens2
IMUL EBX, Dens2
MOV ESI, EDI
AND EDI, Mask1010
AND ESI, Mask0101
SHR EDI, 5
IMUL EDI, Dens1
IMUL ESI, Dens1
ADD EAX, EDI
ADD EBX, ESI
AND EAX, Mask1010
SHR EBX, 5
AND EBX, Mask0101
OR EAX, EBX
MOV [ECX], EAX
ADD EBP, 4
ADD ESP, 4
ADD ECX, 4
CMP EBP, FinA
JNE @LOOPA
@FINAL:
MOV EBX, &EBX
MOV EDI, &EDI
MOV ESI, &ESI
MOV ESP, &ESP
MOV EBP, &EBP
End;
{procedure TTButton.Blend;
var
r : integer;
bmpT : TBitmap;
begin
bmpT := TBitmap.Create;
bmpT.Assign( FDrawImgSel );
for r := 0 to 250 do
begin
Blendit(Pt(FDrawImgNSel),Pt(bmpT),Pt(FDrawImgSel),Width,Height,(r*$20 Div 250));
Paint;
{ if FProcMsg = TRUE then
Application.ProcessMessages;
}
{ if FFinish = TRUE then begin
Complete;
Exit;
end;
}
{ end;
end;
}
procedure Register;
begin
RegisterComponents('Samples', [TTButton]);
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -