gradbtn.pas

DBchart的高级使用

  ColorRect.Left:= 0;                //Set rectangle left&right
  ColorRect.Right:= Width;
  for I := 0 to 255 do begin         //Make lines (rectangles) of color
    ColorRect.Top:= Muldv (I, Height, 256);    //Find top for this color
    ColorRect.Bottom:= Muldv (I + 1, Height, 256);   //Find Bottom
    R := fr + Muldv(I, dr, 255);    //Find the RGB values
    G := fg + Muldv(I, dg, 255);
    B := fb + Muldv(I, db, 255);
    bm.Canvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    bm.Canvas.FillRect(ColorRect);           //Draw on Bitmap
  end;
end;

procedure TGradBtn.DoElliptic(fr, fg, fb, dr, dg, db : Integer);
var
  I: Integer;
  R, G, B : Byte;
  Pw, Ph, Dw, Dh : integer;
  x1,y1,x2,y2 : integer;
{The elliptic is a bit different, since I had to use real numbers. I cut down
 on the number (to 155 instead of 255) of iterations in an attempt to speed
 things up, to no avail.  I think it just takes longer for windows to draw an
 ellipse as opposed to a rectangle.}
begin
  bm.Canvas.Pen.Style := psClear;
  bm.Canvas.Pen.Mode := pmCopy;
  x1 := bm.Width div -3;
  x2 := bm.Width + (bm.Width div 3);
  y1 := bm.Height div -3;
  y2 := bm.Height + (bm.Height div 3);
  Pw := x2 - x1;
  Ph := y2 - y1;
  for I := 0 to 50 do begin         //Make ellipses of color
    R := fr + Muldv(I, dr, 50);    //Find the RGB values
    G := fg + Muldv(I, dg, 50);
    B := fb + Muldv(I, db, 50);
    bm.Canvas.Brush.Color := R or (G shl 8) or (b shl 16);   //Plug colors into brush
    Dw := Pw * i div 100;
    Dh := Ph * i div 100;
    bm.Canvas.Ellipse(x1 + Dw,y1 + Dh,x2 - Dw,y2 - Dh);
  end;
  bm.Canvas.Pen.Style := psSolid;
end;

procedure TGradBtn.DoRectangle(fr, fg, fb, dr, dg, db : Integer);
var
  I: Integer;
  R, G, B : Byte;
  Pw, Ph : Real;
  x1,y1,x2,y2 : Real;
begin
  bm.Canvas.Pen.Style := psClear;
  bm.Canvas.Pen.Mode := pmCopy;
  x1 := 0;
  x2 := bm.Width+2;
  y1 := 0;
  y2 := bm.Height+2;
  Pw := (bm.Width / 2) / 255;
  Ph := (bm.Height / 2) / 255;
  for I := 0 to 255 do begin         //Make rectangles of color
    x1 := x1 + Pw;
    x2 := X2 - Pw;
    y1 := y1 + Ph;
    y2 := y2 - Ph;
    R := fr + Muldv(I, dr, 255);    //Find the RGB values
    G := fg + Muldv(I, dg, 255);
    B := fb + Muldv(I, db, 255);
    bm.Canvas.Brush.Color := RGB(R, G, B);   //Plug colors into brush
    bm.Canvas.FillRect(Rect(Trunc(x1),Trunc(y1),Trunc(x2),Trunc(y2)));
  end;
  bm.Canvas.Pen.Style := psSolid;
end;

procedure TGradBtn.DoVertCenter(fr, fg, fb, dr, dg, db : Integer);
var
  ColorRect: TRect;
  I: Integer;
  R, G, B : Byte;
  Haf : Integer;
begin
  Haf := bm.Height Div 2;
  ColorRect.Left := 0;
  ColorRect.Right := bm.Width;
  for I := 0 to Haf do begin
    ColorRect.Top := Muldv (I, Haf, Haf);
    ColorRect.Bottom := Muldv (I + 1, Haf, Haf);
    R := fr + Muldv(I, dr, Haf);
    G := fg + Muldv(I, dg, Haf);
    B := fb + Muldv(I, db, Haf);
    bm.Canvas.Brush.Color := RGB(R, G, B);
    bm.Canvas.FillRect(ColorRect);
    ColorRect.Top := bm.Height - (Muldv (I, Haf, Haf));
    ColorRect.Bottom := bm.Height - (Muldv (I + 1, Haf, Haf));
    bm.Canvas.FillRect(ColorRect);
  end;
end;

procedure TGradBtn.DoHorizCenter(fr, fg, fb, dr, dg, db : Integer);
var
  ColorRect: TRect;
  I: Integer;
  R, G, B : Byte;
  Haf : Integer;
begin
  Haf := bm.Width Div 2;
  ColorRect.Top := 0;
  ColorRect.Bottom := bm.Height;
  for I := 0 to Haf do begin
    ColorRect.Left := Muldv (I, Haf, Haf);
    ColorRect.Right := Muldv (I + 1, Haf, Haf);
    R := fr + Muldv(I, dr, Haf);
    G := fg + Muldv(I, dg, Haf);
    B := fb + Muldv(I, db, Haf);
    bm.Canvas.Brush.Color := RGB(R, G, B);
    bm.Canvas.FillRect(ColorRect);
    ColorRect.Left := bm.Width - (Muldv (I, Haf, Haf));
    ColorRect.Right := bm.Width - (Muldv (I + 1, Haf, Haf));
    bm.Canvas.FillRect(ColorRect);
  end;
end;

procedure TGradBtn.DoRaise(offset: Integer);
{This draws 'raised' 3D text for the Caption.  Inset is the same principal,
 the colors are just reversed.  The brush style is set to Clear so the
 background is not erased.  The highlight colored text is drawn on the canvas
 at -1 up and left of center.  If heavy shading is set, the shadow colored
 text is drawn at +1 right and down of center.  Finally, the Font.Color colored
 text is drawn in exact center.  The offset parameter is used to 'move' the
 whole shebang down and right 1 if the Mouse is Down.}
var
  r: TRect;
  J : integer;    //For justification
begin
  bm.Canvas.Brush.Style := bsClear;
  bm.Canvas.Font.Color := FTxtHiliteClr;
  J := DT_CENTER;    //Initialize to avoid warnings
  case FJustify of
    jLeft   : begin
                J := DT_LEFT;
                r:=Rect(1+offset,
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)-1+offset,0,0);
              end;
    JCenter : begin
                J := DT_CENTER;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)-1+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)-1+offset,0,0);
              end;
    jRight  : begin
                J := DT_RIGHT;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 2)-1+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)-1+offset,0,0);
              end;
  end;

  DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+J+DT_TOP);
  DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,J+DT_TOP);
  if FShadeType = stHeavy then begin
    bm.Canvas.Font.Color := FTxtShadowClr;

    case FJustify of
      jLeft   : begin
                  J := DT_LEFT;
                  r:=Rect(3+offset,
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+1+offset,0,0);
                end;
      jCenter : begin
                  J := DT_CENTER;
                  r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)+1+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+1+offset,0,0);
                end;
      jRight  : begin
                  J := DT_RIGHT;
                  r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 1)+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+1+offset,0,0);
                end;
    end;

    DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+DT_LEFT+DT_TOP);
    DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,DT_CENTER+DT_TOP);
  end;
  bm.Canvas.Font.Color := Font.Color;
  case FJustify of
    jLeft   : begin
                J := DT_LEFT;
                r:=Rect(2+offset,
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
    JCenter : begin
                J := DT_CENTER;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
    jRight  : begin
                J := DT_RIGHT;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 2)+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
  end;

  DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+J+DT_TOP);
  DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,J+DT_TOP);
  bm.Canvas.Brush.Style := bsSolid;
end;

procedure TGradBtn.DoInset(offset: Integer);
var
  r: TRect;
  J : integer;         //For justification
begin
  bm.Canvas.Brush.Style := bsClear;
  J := DT_CENTER;
  if FShadeType = stHeavy then begin
    bm.Canvas.Font.Color := FTxtShadowClr;

    case FJustify of
      jLeft   : begin
                  J := DT_LEFT;
                  r:=Rect(1+offset,
                    ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)-1+offset,0,0);
                end;
      JCenter : begin
                  J := DT_CENTER;
                  r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)-1+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                    ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)-1+offset,0,0);
                end;
      jRight  : begin
                  J := DT_RIGHT;
                  r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 2)-1+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                    ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)-1+offset,0,0);
                end;
    end;

    DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+J+DT_TOP);
    DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,J+DT_TOP);
  end;

  bm.Canvas.Font.Color := FTxtHiliteClr;

  case FJustify of
    jLeft   : begin
                J := DT_LEFT;
                r:=Rect(3+offset,
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+1+offset,0,0);
              end;
    jCenter : begin
                J := DT_CENTER;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)+1+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+1+offset,0,0);
              end;
    jRight  : begin
                J := DT_RIGHT;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 1)+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+1+offset,0,0);
              end;
  end;

  DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+J+DT_TOP);
  DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,J+DT_TOP);

  // Added by AH 13/2/99
  if Enabled then
    bm.Canvas.Font.Color := Font.Color
  else
    bm.Canvas.Font.Color := FDisabledColor;

  case FJustify of
    jLeft   : begin
                J := DT_LEFT;
                r:=Rect(2+offset,
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
    JCenter : begin
                J := DT_CENTER;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
    jRight  : begin
                J := DT_RIGHT;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 2)+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
  end;


  DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+J+DT_TOP);
  DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,J+DT_TOP);
  bm.Canvas.Brush.Style := bsSolid;
end;

procedure TGradBtn.DoNorm(offset: Integer);
var
  r: TRect;
  J : integer;  //For justification
begin           //If no 3D effect is set, we just draw text
  bm.Canvas.Brush.Style := bsClear;
  bm.Canvas.Font.Color := Font.Color;
  J := DT_CENTER;     //Initialized to avoid warnings
  case FJustify of
    jLeft   : begin
                J := DT_LEFT;
                r:=Rect(2+offset,
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
    JCenter : begin
                J := DT_CENTER;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) div 2)+offset{$IFDEF VER120}+FMarkerOffset{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
    jRight  : begin
                J := DT_RIGHT;
                r:=Rect(((bm.Width-bm.Canvas.TextWidth(Caption2)) - 2)+offset{$IFDEF VER120}+FMarkerOffset-6{$ENDIF},
                  ((bm.Height-bm.Canvas.TextHeight(Caption)) div 2)+offset,0,0);
              end;
  end;

    DrawText(bm.Canvas.Handle,PChar(Caption2),-1,r,DT_CALCRECT+J+DT_TOP);
    DrawText(bm.Canvas.Handle,PChar(Caption),-1,r,J+DT_TOP);
    bm.Canvas.Brush.Style := bsSolid;
end;

destructor TGradBtn.Destroy;
begin
  bm.Free;       //Cleanup the bitmap - no memory leaks
  inherited Destroy;
end;

{I added the following to allow the Enter key to behave as a Click.}
 {If return key was pressed, do a 'Click'.  This only happens if
  we have the 'Focus'.}
procedure TGradBtn.KeyPress(var Key: Char);
begin
  inherited;
  if Key = Chr(13) then Click;
end;

{$IFDEF VER120}
procedure TGradBtn.DrawPopupMark;
// Added by AH 13/2/99
var
  y : Integer;
begin
	y := (Height - 4) div 2;
  with bm.Canvas do
  begin
    Pen.Color := Font.Color;
    Brush.Color := Font.Color;
    Brush.Style := bsSolid;
    Polygon ([Point (Width - 14, y), Point (Width - 8, y), Point (Width - 11, y + 3)]);
  end;
end;

procedure TGradBtn.SetDropdownMenu (Value: TPopupMenu);
// Added by AH 13/2/99
begin
  if FDropdownMenu <> Value then
  begin
    FDropdownMenu := Value;
    if Assigned(Value) then Value.FreeNotification (Self);
    Invalidate;
  end;
end;

procedure TGradBtn.Notification (AComponent: TComponent; Operation: TOperation);
// Added by AH 13/2/99
begin
  inherited;
  if (Operation = opRemove) and (AComponent = DropdownMenu) then DropdownMenu := nil;
end;
{$ENDIF}

procedure TGradBtn.SetEnabled(value: Boolean);
// Added by AH 13/2/99
begin
  inherited;
  invalidate;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TGradBtn]);
end;

end.