?? hemispherebutton.pas
字號:
if fAttenControl <> Value then begin
fAttenControl := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetBevelWidth(Value: Integer);
begin
if (fBevelWidth <> Value) and (Value >= 1) then begin
fBevelWidth := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetBevelInner(Value: THemisphereBevel);
begin
if fBevelInner <> Value then begin
fBevelInner := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetBevelOuter(Value: THemisphereBevel);
begin
if fBevelOuter <> Value then begin
fBevelOuter := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetBorderColor(Value: TColor);
begin
if fBorderColor <> Value then begin
fBorderColor := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetBorderStyle(Value: TBorderStyle);
begin
if fBorderStyle <> Value then begin
fBorderStyle := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetBounds(aLeft, aTop, aWidth, aHeight: Integer);
begin
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
if (aWidth <> oldWidth) or (aHeight <> oldHeight) then begin
if not (csLoading in ComponentState) then begin
CalcImages;
Invalidate;
end;
oldWidth := aWidth;
oldHeight := aHeight;
end;
end;
procedure THemiBtn.SetCaption(Value: String);
begin
if fCaption <> Value then begin
fCaption := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetDown(Value: Boolean);
begin
if fDown <> Value then begin
fDown := Value;
Paint; {Invalidate;}
end;
end;
procedure THemiBtn.SetFaceColor(Value: TColor);
begin
if fFaceColor <> Value then begin
faceBlue := (Value shr 16) and $ff;
faceGreen := (Value shr 8) and $ff;
faceRed := Value and $ff;
fFaceColor := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetFaceShaded(Value: Boolean);
begin
if fFaceShaded <> Value then begin
fFaceShaded := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetFaceTransparent(Value: Boolean);
begin
if fFaceTransparent <> Value then begin
fFaceTransparent := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetFont(Value: TFont);
begin
fFont.Assign(Value);
CalcImages;
Invalidate;
end;
procedure THemiBtn.SetGlyph(Value: TBitmap);
var
r: TRect;
begin
if bmGlpyh <> Value then begin
if Value = nil then
GlyphValid := False
else begin
GlyphValid := True;
bmGlpyh.Width := Value.Width;
bmGlpyh.Height := Value.Height;
r := Rect(0, 0, Value.Width, Value.Height);
bmGlpyh.Canvas.CopyRect(r, Value.Canvas, r);
if (bmGlpyh.Height<>0) and (bmGlpyh.Width mod bmGlpyh.Height=0) then
fNumGlyphs := bmGlpyh.Width div bmGlpyh.Height
else
fNumGlyphs := 1;
fGlyphIndex := 1;
end;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetGlyphIndex(Value: Integer);
begin
if (fGlyphIndex <> Value) and (Value > 0) and
((csLoading in ComponentState) or (Value <= fNumGlyphs)) then begin
fGlyphIndex := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetGlyphMapped(Value: Boolean);
begin
if fGlyphMapped <> Value then begin
fGlyphMapped := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetGlyphShaded(Value: Boolean);
begin
if fGlyphShaded <> Value then begin
fGlyphShaded := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetGlyphTransparent(Value: Boolean);
begin
if fGlyphTransparent <> Value then begin
fGlyphTransparent := Value;
CalcImages;
Invalidate;
end;
end;
procedure THemiBtn.SetNumGlyphs(Value: Integer);
begin
if fNumGlyphs <> Value then begin
fNumGlyphs := Value;
CalcImages;
Invalidate;
end;
end;
function THemiBtn.InsideEllipse(X,Y: Integer): Boolean;
var
borderSz: Integer;
w2, h2: Double;
begin
w2 := Width/2;
h2 := Height/2;
borderSz := 0;
if fBevelOuter <> hbNone then inc(borderSz, fBevelWidth);
if fBevelInner <> hbNone then inc(borderSz, fBevelWidth);
Result := sqr((X-w2)/(w2-borderSz)) + sqr((Y-h2)/(h2-borderSz)) <= 1.0;
end;
procedure THemiBtn.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Enabled and InsideEllipse(X,Y) then begin
if Assigned(fOnMouseDown) then
fOnMouseDown(Self, Button, Shift, X, Y);
if (Button = mbLeft) then begin
InMousePress := True;
oldDown := Down;
Down := True;
if (ssDouble in Shift) and Assigned(fOnDblClick) then
fOnDblClick(Self);
end;
end;
end;
procedure THemiBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if InMousePress and not oldDown then
Down := InsideEllipse(X,Y);
if Assigned(fOnMouseMove) then
fOnMouseMove(Self, Shift, X, Y);
end;
procedure THemiBtn.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: Integer;
aHb: THemiBtn;
begin
if InMousePress then begin
InMousePress := False;
if InsideEllipse(X,Y) then begin
if Assigned(fOnClick) then
fOnClick(Self);
if GroupIndex = 0 then
Down := False
else begin
if not (not fAllowAllUp and oldDown) then begin
for i:=0 to Owner.ComponentCount-1 do
if (Owner.Components[i] is THemiBtn) and
(Owner.Components[i] <> Self) then begin
aHb := THemiBtn(Owner.Components[i]);
if aHb.GroupIndex = GroupIndex then
aHb.Down := False;
end;
Down := not oldDown;
end;
end;
end;
end;
if Assigned(fOnMouseUp) then
fOnMouseUp(Self, Button, Shift, X, Y);
end;
procedure THemiBtn.RenderBorder(aCanvas: TCanvas; X0,Y0,X1,Y1, bevWidth: Integer; Raised: Boolean);
var
cX, cY, Len2d, Len3d, dirX, dirY, dirZ: Double;
aGreyVal, nWayDelta: Longint;
procedure SetPixel(X,Y: Integer; normX, normY, normZ: Double);
begin
aGreyVal := 128 + Round(128*(cLightX*normX + cLightY*normY + cLightZ*normZ));
if aGreyVal > 255 then aGreyVal := 255
else if aGreyVal < 0 then aGreyVal := 0;
aCanvas.Pixels[x,y] := (aGreyVal shl 16) or (aGreyVal shl 8) or aGreyVal;
end;
procedure SetPixel4Way(X, Y: Integer);
begin
if (X=0) and (Y=0) then begin
SetPixel(0,0,0,0,1);
exit;
end;
Len2d := sqrt(sqr(X)+sqr(Y));
Len3d := sqrt(sqr(X)+sqr(Y)+sqr(Len2d));
dirX := -X/Len3d;
dirY := Y/Len3d;
dirZ := Len2d/Len3d;
if not Raised then begin
dirX := -dirX;
dirY := -dirY;
end;
SetPixel(Ceil(cX+X), Ceil(cY-Y), -dirX, -dirY, dirZ); { Right-Top }
SetPixel(Ceil(cX+X), Floor(cY+Y), -dirX, dirY, dirZ); { Right-Bottom }
SetPixel(Floor(cX-X), Floor(cY+Y), dirX, dirY, dirZ); { Left-Bottom }
SetPixel(Floor(cX-X), Ceil(cY-Y), dirX, -dirY, dirZ); { Left-Top }
end;
procedure SetPixelNWay(X,Y: Integer);
var
i, j: Integer;
begin
for i := Y-nWayDelta to Y+nWayDelta do
for j := X-nWayDelta to X+nWayDelta do
SetPixel4Way(j, i);
end;
var
a, b, x, y, a2, b2, d1, d2: Double;
begin
nWayDelta := 1 + Ceil(bevWidth/2);
a := (X1-X0-1) / 2;
b := (Y1-Y0-1) / 2;
cX := X0 + a;
cY := Y0 + b;
x := 0;
y := b;
a2 := sqr(a);
b2 := sqr(b);
d1 := b2 - a2*b + a2/4;
SetPixelNWay(Round(x), Round(y));
while (a2*(y-0.5) > b2*(x+1)) do begin
if d1 < 0 then begin
d1 := d1 + b2*(2*x+3);
x := x + 1;
end else begin
d1 := d1 + b2*(2*x+3)+a2*(-2*y+2);
x := x + 1;
y := y - 1;
end;
SetPixelNWay(Round(x), Round(y));
end;
d2 := b2*sqr(x+0.5)+a2*sqr(y-1)-a2*b2;
while y > 0 do begin
if d2 < 0 then begin
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -