hemispherebutton.pas

机房管理系统 是用VB设计的简单的管理系统

      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.