gradbtn.pas

DBchart的高级使用

  end;
end;

procedure TGradBtn.SetDisabledColor(Value: TColor);
// Added by AH 13/2/99
begin
  if FDisabledColor <> Value then begin
    FDisabledColor := Value;
    Invalidate;  //Invalidate tells windows to do a Paint.  Our control
  end;           // goes through its Paint procedure.
end;

procedure TGradBtn.SetBtnHilite(Value: TColor);
begin
  if FBtnHiliteClr <> Value then begin
    FBtnHiliteClr := Value;
    Invalidate;  //Invalidate tells windows to do a Paint.  Our control
  end;           // goes through its Paint procedure.
end;

procedure TGradBtn.SetBtnShadow(Value: TColor);
begin
  if FBtnShadowClr <> Value then begin
    FBtnShadowClr := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetBtnFrameSize(Value: Integer);
begin
  if FBtnFrameSize <> Value then begin
    if Value > ((Width Div 2) - 5) then exit;
    if Value > ((Height Div 2) - 5) then exit;
    FBtnFrameSize := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetTxtHilite(Value: TColor);
begin
  if FTxtHiliteClr <> Value then begin
    FTxtHiliteClr := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetTxtShadow(Value: TColor);
begin
  if FTxtShadowClr <> Value then begin
    FTxtShadowClr := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetBeginClr(Value : TColor);
begin
  if FBeginClr <> Value then begin
    FBeginClr := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetEndClr(Value : TColor);
begin
  if FEndClr <> Value then begin
    FEndClr := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetSwap(Value : Boolean);
begin
  if FSwapClr <> Value then
    FSwapClr := Value;
end;

procedure TGradBtn.SetShowFocus(Value : Boolean);
begin
  if FShowFocus <> Value then
    FShowFocus := Value;
end;

procedure TGradBtn.MouseDown(Button:TMouseButton; Shift:TShiftState;
      X, Y: Integer);
{$IFDEF VER120}
var
  PopupPoint : TPoint;
{$ENDIF}
begin
  inherited;
  if not mUp then exit; // don't do more than once
  if Button = mbLeft then mUp := FALSE;
  SetFocus;
  if FSwapClr = TRUE then begin    //If SwapClrs is true, we need to save
    TmpClr := FBeginClr;           // the original stuff.  Hence, TmpClr
    FBeginClr := FEndClr;
    FEndClr := TmpClr;
  end;
  Invalidate;
  {$IFDEF VER120}
  if (not FMenuPoppedUp) and Assigned (DropDownMenu) and (Button = mbLeft) then
  begin
    PopupPoint := ClientToScreen(Point(0, Height));
    FMenuPoppedUp := True;
    with DropdownMenu do
    begin
      PopupComponent := Self;
      TrackButton := tbLeftButton;
      Popup (PopupPoint.X, PopupPoint.Y);
    end;
    MouseUp (Button, Shift, X, Y);
    ControlState := ControlState - [csLButtonDown];
end;
  {$ENDIF}
end;

procedure TGradBtn.MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y: Integer);
begin
  inherited;
  if Clicking then begin
    Clicking := FALSE;
    exit;
  end;
  if mUp then exit; // don't do more than once
  if (FSwapClr = TRUE) and (mUp = FALSE) then begin
    TmpClr := FBeginClr;
    FBeginClr := FEndClr;
    FEndClr := TmpClr;
  end;
  mUp := TRUE;
  Invalidate;
end;

procedure TGradBtn.Click;   //Added this so I can re-draw button
begin
  Clicking := TRUE;
  if FSwapClr = TRUE then begin
    TmpClr := FBeginClr;
    FBeginClr := FEndClr;
    FEndClr := TmpClr;
  end;
  mUp := TRUE;
  Invalidate;
  Application.ProcessMessages;
  inherited;
end;

procedure TGradBtn.CMTextChanged(var Msg:TMessage);
begin
  Inherited;
  Invalidate;
end;

{$IFNDEF VER120}
procedure TGradBtn.CMEnabledChanged(var Message: TMessage);
begin
  Inherited;
  Invalidate;
end;
{$ENDIF}

procedure TGradBtn.WMEraseBkgnd(var Msg:TMessage);
begin
  Msg.Result := 0;  //We intercept this message and tell
end;                // Windows it processed OK.

procedure TGradBtn.WMSetFocus(var Msg:TWMSetFocus);
begin
  inherited;
  if csDesigning in ComponentState then exit;
  Invalidate;
end;

procedure TGradBtn.WMKillFocus(var Msg:TWMKillFocus);
begin
  inherited;
  if csDesigning in ComponentState then exit;
  Invalidate;
end;

procedure TGradBtn.SetGradient(Value : TGradientStyle);
begin
  if FGradientStyle <> Value then begin
    FGradientStyle := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetJustify(Value : TJustification);
begin
  if FJustify <> Value then begin
    FJustify := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetStyle(Value: TTextStyle);
begin
  {When user selects a style, set the variable to new style and do
   an invalidate to force a re-paint of the component.}
  if FTextStyle <> Value then begin
    FTextStyle := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetShade(Value: TShadeType);
begin
  {When user selects a shade, set the variable to new type and do
   an invalidate to force a re-paint of the component.}
  if FShadeType <> Value then begin
    FShadeType := Value;
    Invalidate;
  end;
end;

procedure TGradBtn.SetPreset(Value: TPreset);
begin
 if csDesigning in ComponentState then begin
  case Value of
    None : begin
      FDisabledColor := clGray;
      FBeginClr := clNavy;
      FEndClr := clAqua;
      Font.Size := 8;
      Font.Name := 'MS Sans Serif';
      Font.Color := clBlack;
      Font.Style := [];
      FGradientStyle := gsVertCenter;
      FShadeType := stLight;
      FTextStyle := tsRaised;
      FTxtHiliteClr := clBtnHighLight;
      FTxtShadowClr := clBtnShadow;
      FBtnHiliteClr := clBtnHighlight;
      FBtnShadowClr := clBtnShadow;
    end;
    GoldCoast : begin
      FDisabledColor := $0000bbbb;
      FBeginClr := clYellow;
      FEndClr := clOlive;
      Font.Size := 10;
      Font.Name := 'Arial';
      Font.Color := $0000bbbb;
      Font.Style := [fsBold];
      FGradientStyle := gsVertical;
      FShadeType := stHeavy;
      FTextStyle := tsRaised;
      FTxtHiliteClr := $00bfffff;
      FTxtShadowClr := $00007171;
      FBtnHiliteClr := $00b3ffff;
      FBtnShadowClr := $00616161;
    end;
    LimeBox : begin
      FDisabledColor := clOlive;
      FBeginClr := clBlack;
      FEndClr := clLime;
      Font.Size := 8;
      Font.Name := 'Courier';
      Font.Color := clGreen;
      Font.Style := [];
      FGradientStyle := gsRectangle;
      FShadeType := stLight;
      FTextStyle := tsRaised;
      FTxtHiliteClr := $00acffac;
      FTxtShadowClr := $00004000;
      FBtnHiliteClr := clBtnHighLight;
      FBtnShadowClr := clBtnShadow;
    end;
    Aluminum : begin
      FDisabledColor := clGray;
      FBeginClr := $00cecece;
      FEndClr := $005f5f5f;
      Font.Size := 10;
      Font.Name := 'Times New Roman';
      Font.Color := clBlack;
      Font.Style := [fsBold];
      FGradientStyle := gsVertical;
      FShadeType := stHeavy;
      FTextStyle := tsInset;
      FTxtHiliteClr := clBtnHighlight;
      FTxtShadowClr := clBtnShadow;
      FBtnHiliteClr := clWhite;
      FBtnShadowClr := clBlack;
    end;
    SunRise : begin
      FDisabledColor := clGray;
      FBeginClr := clYellow;
      FEndClr := clRed;
      Font.Size := 8;
      Font.Name := 'MS Sans Serif';
      Font.Color := $00000040;
      Font.Style := [fsBold];
      FGradientStyle := gsHorizontal;
      FShadeType := stHeavy;
      FTextStyle := tsRaised;
      FTxtHiliteClr := $00cfe7e6;
      FTxtShadowClr := $000058b0;
      FBtnHiliteClr := clBtnHighlight;
      FBtnShadowClr := clBtnShadow;
    end;
    BrassedOff : begin
      FDisabledColor := clOlive;
      FBeginClr := $00CEFFFF;
      FEndClr := $0092C2C2;
      Font.Size := 9;
      Font.Name := 'Verdana';
      Font.Color := clMaroon;
      Font.Style := [];
      FGradientStyle := gsElliptic;
      FShadeType := stLight;
      FTextStyle := tsNormal;
      FSwapClr := False;
      FTxtHiliteClr := $00EFFFFF;
      FTxtShadowClr := $0092C2C2;
      FBtnHiliteClr := $00EFFFFF;
      FBtnShadowClr := $0092C2C2;
    end;
    else
      Exit;
  end;
  FPreset := Value;
  Invalidate;
 end;
end;

{The following two procedures process user code that can be specified in the
 events for the component.  These are often used to change the color when the
 mouse enters a control, or something like that.  I made these into events so
 the user can trigger whatever code they wish without modifying/creating a
 component.}
procedure TGradBtn.CMMouseEnter(var Msg:TMessage);
begin
  inherited;
  if csLButtonDown in ControlState then begin
    Self.MouseDown(mbLeft,[ssLeft],0,0); //Passed values are ignored
  end;
  if Assigned (FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TGradBtn.CMMouseLeave(var Msg:TMessage);
begin
  inherited;
  if csLButtonDown in ControlState then begin
    Self.MouseUp(mbLeft,[ssLeft],0,0);  //Passed values are ignored
  end;
  if Assigned (FonMouseLeave) then FOnMouseLeave(Self);
end;

{I'll explain a little about the Horizontal gradient, the other styles are all
 consistent with their logic.  The six R, G, and B values are passed to us.
 We define some local variables we'll need: a rectangle, a FOR loop counter,
 and our own RGB numbers.  For a horizontal gradient, we'll draw a series of
 rectangles, each one a little closer in color to the EndClr value.  A horizontal
 gradient rectangle will always be from the top to the bottom of the canvas,
 so we set top to 0 and bottom to however tall our control is.  Then, we draw
 a series of 255 rectangles.  The starting point and width of each will depend
 on the actual width of our control.  It starts out on the left, draws the
 first rectangle in a color that's a percentage of the difference plus the
 starting color.  As I increments through the loop, the rectangles move to the
 right and the color gets closer and closer to the EndClr.}
procedure TGradBtn.DoHorizontal(fr, fg, fb, dr, dg, db : Integer);
var
  ColorRect: TRect;
  I: Integer;
  R, G, B : Byte;
begin
  ColorRect.Top:= 0;                //Set rectangle top
  ColorRect.Bottom := Height;
  for I := 0 to 255 do begin         //Make lines (rectangles) of color
    ColorRect.Left:= Muldv (I, Width, 256);    //Find left for this color
    ColorRect.Right:= Muldv (I + 1, Width, 256);   //Find Right
    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.DoVertical(fr, fg, fb, dr, dg, db : Integer);
var
  ColorRect: TRect;
  I: Integer;
  R, G, B : Byte;
begin