?? hemispherebutton.pas
字號:
d2 := d2 + b2*(2*x+2)+a2*(-2*y+3);
x := x + 1;
y := y - 1;
end else begin
d2 := d2 + a2*(-2*y + 3);
y := y - 1;
end;
SetPixelNWay(Round(x), Round(y));
end;
end;
procedure THemiBtn.RenderButtonFaces(nBorder: Integer; mskBorder, canvUp, canvDown: TCanvas);
var
glyWidth, glyHeight, glyXOfs,
x, y, xlen, ylen, x0, x1, y0, y1,
gX, gY, w, h: Integer;
cx, cy, Xe, Ye, Ze, atten: Double;
rr, gg, bb, rrr, ggg, bbb, transp, col: TColor;
isFromGlyph: Boolean;
procedure SetFacePixel(pX, pY: Integer; normX, normY, normZ: Double);
function CalcRGBAtten: TColor;
begin
rrr := rr + Round(rr * atten);
ggg := gg + Round(gg * atten);
bbb := bb + Round(bb * atten);
if rrr < 0 then rrr := 0 else if rrr > 255 then rrr := 255;
if ggg < 0 then ggg := 0 else if ggg > 255 then ggg := 255;
if bbb < 0 then bbb := 0 else if bbb > 255 then bbb := 255;
Result := (bbb shl 16) or (ggg shl 8) or rrr;
end;
begin
isFromGlyph := false;
if GlyphValid then begin
if fGlyphMapped then begin
gX := Floor((glyWidth-1) * arctan2(normZ, -normX) / Pi);
gY := Floor((glyHeight-1) * arctan2(normZ, -normY) / Pi);
end else begin { map glyph 1:1 }
gX := Floor(glyWidth/2 + pX - cx);
gY := Floor(glyHeight/2 + pY - cy);
end;
{ [gX, gY] inside glyph? }
if (gX>=0) and (gX<glyWidth) and (gY>=0) and (gY<glyHeight) then begin
col := bmGlpyh.Canvas.Pixels[glyXOfs + gX, gY];
if not fGlyphTransparent or (col <> transp) then begin
rr := col and 255;
gg := (col shr 8) and 255;
bb := (col shr 16) and 255;
isFromGlyph := true;
end;
end;
end;
if not isFromGlyph then begin
if fFaceTransparent then begin
{ enable pixels in bmMask only if not on Border }
if mskBorder.Pixels[pX, pY] <> clWhite then
bmMask.Canvas.Pixels[pX, pY] := clWhite;
exit;
end;
rr := faceRed;
gg := faceGreen;
bb := faceBlue;
end;
if (not isFromGlyph and fFaceShaded) or (isFromGlyph and fGlyphShaded) then begin
atten := fAttenControl * (cLightX*normX + cLightY*normY + cLightZ*normZ);
canvUp.Pixels[pX, pY] := CalcRGBAtten;
atten := -atten;
canvDown.Pixels[pX, pY] := CalcRGBAtten;
end else begin
col := (bb shl 16) or (gg shl 8) or rr;
canvUp.Pixels[pX, pY] := col;
canvDown.Pixels[pX, pY] := col;
end;
end;
begin
transp := bmGlpyh.Canvas.Pixels[0, bmGlpyh.Height-1];
if GlyphValid then begin
glyHeight := bmGlpyh.Height;
if fNumGlyphs = 1 then begin
glyWidth := bmGlpyh.Width;
glyXOfs := 0;
end else begin
glyWidth := bmGlpyh.Width div fNumGlyphs;
glyXOfs := glyWidth * (fGlyphIndex-1);
end;
end;
cx := Width/2;
cy := Height/2;
w := Width - nBorder * fBevelWidth;
h := Height - nBorder * fBevelWidth;
ylen := Floor(h/2);
for y:=0 to ylen do begin
Ye := y/cy;
y0 := Floor(cy - y);
y1 := Ceil(cy + y);
xlen := Ceil(sqrt(1-sqr(Ye))*w/2);
if xlen > 1 then
for x:=0 to xlen do begin
Xe := x/cx;
Ze := 1-sqrt(sqr(Xe)+sqr(Ye));
x0 := Floor(cx - x);
x1 := Ceil(cx + x);
SetFacePixel(x1,y0, Xe,-Ye,Ze); { Right-Top }
SetFacePixel(x1,y1, Xe, Ye,Ze); { Right-Bottom }
SetFacePixel(x0,y1, -Xe, Ye,Ze); { Left-Bottom }
SetFacePixel(x0,y0, -Xe,-Ye,Ze); { Left-Top }
end;
end;
end;
procedure THemiBtn.CalcImages;
var
r: TRect;
w, h, nBorder: Integer;
bmTmp, mskMiddle, mskInner,
bmDown, bmUp, bmBorderOuter, bmBorderInner: TBitmap;
function NewBitmap(IsMask: Boolean): TBitmap;
begin
Result := TBitmap.Create;
Result.Width := w;
Result.Height := h;
if IsMask then begin
Result.Canvas.Brush.Color := clWhite;
Result.Canvas.FillRect(r);
Result.Canvas.Pen.Color := clBlack;
Result.Canvas.Brush.Color := clBlack;
end;
end;
procedure DrawMasks;
{ All masks (mskMiddle, mskInner and bmMask) contain white pixels
for background, black for foreground pixels. }
begin
if (fBevelOuter = hbNone) and (fBevelInner = hbNone) then
mskMiddle.Canvas.Ellipse(0,0,w,h)
else
mskMiddle.Canvas.Ellipse(fBevelWidth, fBevelWidth, w-fBevelWidth, h-fBevelWidth);
if (fBevelOuter = hbNone) or (fBevelInner = hbNone) then
mskInner.Canvas.CopyRect(r, mskMiddle.Canvas, r)
else
mskInner.Canvas.Ellipse(2*fBevelWidth, 2*fBevelWidth, w-fBevelWidth*2, h-fBevelWidth*2);
bmMask.Width := w;
bmMask.Height := h;
bmMask.Canvas.Brush.Color := clWhite;
bmMask.Canvas.FillRect(r);
bmMask.Canvas.Pen.Color := clBlack;
bmMask.Canvas.Brush.Color := clBlack;
bmMask.Canvas.Ellipse(0,0,w,h);
end;
procedure DrawBorders;
var
ofs: Integer;
begin
nBorder := 0;
if (fBevelOuter = hbNone) and (fBevelInner = hbNone) then
exit;
if (fBevelOuter = hbNone) and (fBevelInner <> hbNone) then begin
nBorder := 1;
bmBorderOuter := NewBitmap(False); { inner border only }
ofs := Ceil(fBevelWidth / 2);
RenderBorder(bmBorderOuter.Canvas, ofs, ofs, w-ofs, h-ofs, fBevelWidth, fBevelInner = hbRaised);
bmBorderOuter.Canvas.CopyMode := cmSrcAnd; { clip to mskMiddle and !mskOuter }
bmBorderOuter.Canvas.CopyRect(r, mskMiddle.Canvas, r);
end else begin
if (fBevelOuter <> hbNone) then begin { outer border }
inc(nBorder);
bmBorderOuter := NewBitmap(False);
ofs := Floor(fBevelWidth / 2);
RenderBorder(bmBorderOuter.Canvas, ofs, ofs, w-ofs, h-ofs, fBevelWidth, fBevelOuter = hbRaised);
bmBorderOuter.Canvas.CopyMode := cmSrcAnd; { clip to mskMiddle and !mskOuter }
bmBorderOuter.Canvas.CopyRect(r, mskMiddle.Canvas, r);
end;
if (fBevelInner <> hbNone) then begin { inner border }
inc(nBorder);
bmBorderInner := NewBitmap(False);
ofs := Ceil(fBevelWidth + fBevelWidth/2);
RenderBorder(bmBorderInner.Canvas, ofs, ofs, w-ofs, h-ofs, fBevelWidth, fBevelInner = hbRaised);
bmBorderInner.Canvas.CopyMode := cmSrcAnd; { clip to mskInner and !mskMiddle }
bmBorderInner.Canvas.CopyRect(r, mskInner.Canvas, r);
if (fBevelOuter <> hbNone) then begin
bmTmp.Canvas.CopyMode := cmNotSrcCopy; { invert & copy }
bmTmp.Canvas.CopyRect(r, mskMiddle.Canvas, r);
bmBorderInner.Canvas.CopyRect(r, bmTmp.Canvas, r);
end;
end;
end;
end;
procedure DrawCaption;
var
tx, ty: Integer;
begin
if fCaption = '' then
exit;
bmUp.Canvas.Font.Assign(Font);
bmDown.Canvas.Font.Assign(Font);
bmUp.Canvas.Brush.Style := bsClear;
bmDown.Canvas.Brush.Style := bsClear;
tx := Round((w-2 - bmUp.Canvas.TextWidth(fCaption))/2);
ty := Round((h-2 - bmUp.Canvas.TextHeight(fCaption))/2);
bmUp.Canvas.TextOut(tx, ty, fCaption);
bmDown.Canvas.TextOut(tx, ty, fCaption);
if fFaceTransparent then begin { paint the caption (in black) into bmMask }
bmMask.Canvas.Font.Assign(Font);
bmMask.Canvas.Font.Color := clBlack;
bmMask.Canvas.Brush.Style := bsClear;
bmMask.Canvas.TextOut(tx, ty, fCaption);
end;
end;
procedure CombineImages;
var
ofs: Integer;
begin
bmTmp.Width := w;
bmTmp.Height := h;
bmTmp.Canvas.CopyMode := cmNotSrcCopy; { invert & copy }
bmTmp.Canvas.CopyRect(r, mskInner.Canvas, r);
if nBorder > 0 then begin { clip buttons to !mskInner }
bmUp.Canvas.CopyMode := cmSrcAnd;
bmUp.Canvas.CopyRect(r, bmTmp.Canvas, r);
bmDown.Canvas.CopyMode := cmSrcAnd;
bmDown.Canvas.CopyRect(r, bmTmp.Canvas, r);
end;
bmUnpressed.Width := w; bmUnpressed.Height := h;
bmUnpressed.Canvas.CopyMode := cmSrcCopy;
bmUnpressed.Canvas.CopyRect(r, bmUp.Canvas, r);
bmUnpressed.Canvas.CopyMode := cmSrcPaint; { OR }
bmPressed.Width := w; bmPressed.Height := h;
bmPressed.Canvas.CopyMode := cmSrcCopy;
bmPressed.Canvas.CopyRect(r, bmDown.Canvas, r);
bmPressed.Canvas.CopyMode := cmSrcPaint;
if bmBorderOuter <> nil then begin
bmUnpressed.Canvas.CopyRect(r, bmBorderOuter.Canvas, r);
bmPressed.Canvas.CopyRect(r, bmBorderOuter.Canvas, r);
end;
if bmBorderInner <> nil then begin
bmUnpressed.Canvas.CopyRect(r, bmBorderInner.Canvas, r);
bmPressed.Canvas.CopyRect(r, bmBorderInner.Canvas, r);
end;
if fBorderStyle = bsSingle then begin
ofs := nBorder*fBevelWidth;
bmUnpressed.Canvas.Pen.Color := fBorderColor;
bmUnpressed.Canvas.Brush.Style := bsClear;
bmUnpressed.Canvas.Ellipse(ofs, ofs, bmUnpressed.Width-ofs, bmUnpressed.Height-ofs);
bmPressed.Canvas.Pen.Color := fBorderColor;
bmPressed.Canvas.Brush.Style := bsClear;
bmPressed.Canvas.Ellipse(ofs, ofs, bmPressed.Width-ofs, bmPressed.Height-ofs);
end;
end;
begin
w := Width;
h := Height;
if (csLoading in ComponentState) or (w < 2) or (h < 2) then
exit;
r := Rect(0,0,w,h);
bmTmp := nil; mskMiddle := nil; mskInner := nil; bmDown := nil; bmUp := nil;
bmBorderOuter := nil; bmBorderInner := nil;
try
bmTmp := NewBitmap(False);
bmDown := NewBitmap(False);
bmUp := NewBitmap(False);
mskMiddle := NewBitmap(True);
mskInner := NewBitmap(True);
DrawMasks;
DrawBorders;
RenderButtonFaces(nBorder, mskInner.Canvas, bmUp.Canvas, bmDown.Canvas);
DrawCaption;
CombineImages;
finally
bmTmp.Free; mskMiddle.Free; mskInner.Free; bmDown.Free; bmUp.Free;
bmBorderOuter.Free; bmBorderInner.Free;
end;
end;
procedure THemiBtn.Paint;
var
r: TRect;
w, h: Integer;
bmBuf, bmTmp: TBitmap;
begin
if csLoading in ComponentState then
exit;
w := bmMask.Width;
h := bmMask.Height;
r := Rect(0, 0, w, h);
bmTmp := nil;
bmBuf := nil;
try
bmBuf := TBitmap.Create;
bmBuf.Width := w;
bmBuf.Height := h;
bmBuf.Canvas.CopyMode := cmSrcCopy;
bmBuf.Canvas.CopyRect(r, Canvas, r);
bmBuf.Canvas.CopyMode := cmSrcAnd;
bmBuf.Canvas.CopyRect(r, bmMask.Canvas, r); { bmBuf contains erased background }
bmTmp := TBitmap.Create;
bmTmp.Width := w;
bmTmp.Height := h;
bmTmp.Canvas.CopyRect(r, bmMask.Canvas, r);
bmTmp.Canvas.CopyMode := cmSrcErase; { NOT self AND other }
if fDown then bmTmp.Canvas.CopyRect(r, bmPressed.Canvas, r)
else bmTmp.Canvas.CopyRect(r, bmUnpressed.Canvas, r);
bmBuf.Canvas.CopyMode := cmSrcPaint; { self OR other }
bmBuf.Canvas.CopyRect(r, bmTmp.Canvas, r);
Canvas.CopyRect(r, bmBuf.Canvas, r);
finally
bmTmp.Free;
bmBuf.Free;
end;
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -