advglowbutton.pas

来自「一个非常棒的控件.做商业软件特别适用.里面的控件涉及面非常的广,有兴趣的话可以下」· PAS 代码 · 共 1,982 行 · 第 1/5 页

    x1 := r.Left;
    y1 := r.Top;
    x2 := w;
    y2 := h;

    if AutoSize then
    begin
      x2 := 4096;
      y2 := 4096;
    end;

    rectf := MakeRect(x1,y1,x2,y2);

    if WordWrap then
      stringFormat := TGPStringFormat.Create(0)
    else
      stringFormat := TGPStringFormat.Create(GDIP_NOWRAP);

    if Enabled then
      solidBrush := TGPSolidBrush.Create(ColorToARGB(AFont.Color))
    else
      solidBrush := TGPSolidBrush.Create(ColorToARGB(clGray));

    // Center-justify each line of text.
   // stringFormat.SetAlignment(StringAlignmentCenter);
    case Layout of
      blGlyphLeftAdjusted: stringFormat.SetAlignment(StringAlignmentNear);
      blGlyphRightAdjusted: stringFormat.SetAlignment(StringAlignmentFar);
      else stringFormat.SetAlignment(StringAlignmentCenter);
    end;

    // Center the block of text (top to bottom) in the rectangle.
    stringFormat.SetLineAlignment(StringAlignmentCenter);
    stringFormat.SetHotkeyPrefix(HotkeyPrefixShow);

    case AntiAlias of
    aaClearType:graphics.SetTextRenderingHint(TextRenderingHintClearTypeGridFit);
    aaAntiAlias:graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
    end;

    if (AntiAlias = aaNone) or not ttf then
    begin
      Canvas.Font.Assign(AFont);
      szRect.Left := round(rectf.X);
      szRect.Top := round(rectf.Y);

      szRect.Right := szRect.Left + 2;
      szRect.Bottom := DrawText(Canvas.Handle,PChar(Caption),Length(Caption), szrect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DT_VCENTER);

      sizeRect.X := szRect.Left;
      sizeRect.Y := szRect.Top;
      sizeRect.Width := szRect.Right - szRect.Left;
      sizeRect.Height := szRect.Bottom - szRect.Top;
    end
    else
      graphics.MeasureString(Caption, Length(Caption), font, rectf, stringFormat, sizerect);

    Result.cx := ImgW + Spacing + round(sizerect.Width);
    Result.cy := Max(ImgH + Spacing, Spacing + round(sizerect.Height));

    if not AutoSize then
    begin
      if not WordWrap then
      begin
        x2 := w;
        y2 := h;
        rectf := MakeRect(x1,y1,x2,y2);
      end;

      if (ImgW > 0) then
      begin
        case Layout of
          blGlyphLeft, blGlyphLeftAdjusted:
          begin
            x1 := r.Left + 2 + ImgW;
            x2 := w - 2 - ImgW;

            ImgX := round(sizerect.X - ImgW div 2);
            if ImgX < 2 then ImgX := 2;
            ImgY := r.Top + Max(0, (h - ImgH) div 2);
          end;
          blGlyphTop:
          begin
            y1 := r.Top{ + 2} + ImgH;
            y2 := h - 2 - ImgH;

            ImgX := r.Left + Max(0, (w - ImgW) div 2);
            ImgY := round(y2 - sizerect.Height);
            ImgY := Max(0, ImgY div 2);
            ImgY := round(y1) - ImgH + ImgY; //round(sizerect.Height) - ImgY - 4;
            if ImgY < 2 then ImgY := 2;
          end;
          blGlyphRight, blGlyphRightAdjusted:
          begin
            x1 := 2;
            x2 := w - 4 - ImgW;
            if Layout = blGlyphRightAdjusted then
              ImgX := w - ImgW - 2
            else
            begin

               ImgX := round(X2 - sizerect.width);
               ImgX := Max(0, ImgX div 2);
               ImgX := ImgX + round(sizerect.width) + 4;
               if ImgX > (w - ImgW) then
                 ImgX := w - ImgW - 2;
            end;
            ImgY := r.Top + Max(0, (h - ImgH) div 2);
          end;
          blGlyphBottom:
          begin
            y1 := 2;
            y2 := h - 2 - ImgH;

            ImgX := r.Left + Max(0, (w - ImgW) div 2);
            ImgY := round(y2 - sizerect.Height);
            ImgY := Max(0, ImgY div 2);
            ImgY := round(sizerect.Height + 2) + ImgY;
            if ImgY > (h - ImgH) then ImgY := h - ImgH - 2;
          end;
        end;
      end;

      if OverlapText then
        rectf := MakeRect(r.Left, r.Top, r.Right, r.Bottom)
      else
        rectf := MakeRect(x1,y1,x2,y2);

      if DrawPic and OverlapText then
      begin
        if Assigned(Glyph) and not Glyph.Empty and (Glyph.Width > 1) and (Glyph.Height > 1) then
          Canvas.Draw(ImgX, ImgY, Glyph);
      end;

      if DrawCaption then
      begin
        if (AntiAlias = aaNone) or not ttf then
        begin
          szRect.Left := round(rectf.X);
          szRect.Top := round(rectf.Y);
          szRect.Right := szRect.Left + round(rectf.Width);
          szRect.Bottom := szRect.Top + round(rectf.Height);
          Canvas.Brush.Style := bsClear;
          DrawText(Canvas.Handle,PChar(Caption),Length(Caption), szrect, DT_CENTER or DT_VCENTER or DT_SINGLELINE)
        end
        else
          graphics.DrawString(Caption, Length(Caption), font, rectf, stringFormat, solidBrush);
      end;
    end;

    stringformat.Free;
    solidBrush.Free;
    font.Free;
  end;

  fontFamily.Free;

  if not AutoSize then
  begin
    if DropDownButton then
    begin
      if DropDownPos = dpRight then
        w := w - 8
      else
        h := h - 8;
    end;

    if DrawPic and not OverlapText then
    begin
      if Assigned(Glyph) and not Glyph.Empty and (Glyph.Width > 1) and (Glyph.Height > 1) then
      begin
         if Caption = '' then
           Canvas.Draw(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), Glyph)
         else
           Canvas.Draw(ImgX, ImgY, Glyph);
      end
      else
        if not Picture.Empty then
        begin
           if Caption = '' then
             Canvas.Draw(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), Picture)
           else
             Canvas.Draw(ImgX, ImgY, Picture);
        end
        else
          if (ImageIndex <> -1) and Assigned(Images) then
          begin
            if Caption = '' then
              Images.Draw(Canvas, r.Left + Max(0, (w - Images.Width) div 2), r.Top + Max(0, (h - Images.Height) div 2), ImageIndex, EnabledImage)
            else
            begin
              Images.Draw(Canvas, ImgX, ImgY, ImageIndex, EnabledImage);
            end;
            {end
            else if Assigned(ToolImage) and not (ToolImage.Empty) and (ToolImage.Width > 1) then
            begin
              if Caption = '' then
                Canvas.Draw(r.Left + Max(0, (w - ImgW) div 2), r.Top + Max(0, (h - ImgH) div 2), ToolImage)
              else
                Canvas.Draw(ImgX, ImgY, ToolImage); }
          end;
    end;

    Canvas.Brush.Style := bsClear;

    if DropDownButton then
    begin
      if DrawDwLine and DropDownSplit then
      begin
        Canvas.Pen.Color := ColorToRGB(PC);
        if (DropDownPos = dpRight) then
        begin
          Canvas.MoveTo(DwR.Left, DwR.Top);
          Canvas.LineTo(DwR.Left, DwR.Bottom);
        end
        else
        begin
          Canvas.MoveTo(DwR.Left, DwR.Top);
          Canvas.LineTo(DwR.Right, DwR.Top);
        end;
      end;

      AP.X := DwR.Left + ((DwR.Right - DwR.Left - 5) div 2);
      AP.Y := DwR.Top + ((DwR.Bottom - DwR.Top - 3) div 2) + 1;
      
      if not Enabled then
        DrawArrow(Canvas, AP, clGray, clWhite, DropDir)
      else
        DrawArrow(Canvas, AP, clBlack, clWhite, DropDir);
    end;
  end;

  graphics.Free;
end;

//------------------------------------------------------------------------------

{TWinCtrl}

procedure TWinCtrl.PaintCtrls(DC: HDC; First: TControl);
begin
  PaintControls(DC, First);
end;

//------------------------------------------------------------------------------

{ TAdvGlowButton }


//------------------------------------------------------------------------------


procedure TAdvCustomGlowButton.CMMouseEnter(var Msg: TMessage);
begin
  inherited;

  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);

  if (csDesigning in ComponentState) then
    Exit;

  if FMouseEnter then
    Exit;

  FHot := true;

  if FLeftDown then
    FDown := true;

  if not Assigned(FTimer) then
  begin
    FTimer := TTimer.Create(self);
    FTimer.OnTimer := TimerProc;
    FTimer.Interval := GlowSpeed;
    FTimer.Enabled := true;
  end;

  if not FDown and (GlowState <> gsPush) then
  begin
    FTimeInc := 20;
    GlowState := gsHover;    
  end;
  Invalidate;

  FMouseInControl := true;
  FMouseEnter := true;
end;

//------------------------------------------------------------------------------

procedure TAdvCustomGlowButton.CMMouseLeave(var Msg: TMessage);
begin
  inherited;

  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);

  if (csDesigning in ComponentState) then
    Exit;

  if not FMouseEnter then
    Exit;

  FMouseEnter := false;
  FMouseInControl := false;

  FHot := false;
  FInButton := false;

  Repaint;

  // down process busy
  if FDown and FMouseDown then
  begin
    FDown := False;
    FTimeInc := -20;
    GlowState := gsHover;
    Invalidate;
    FLeftDown := true;
  end
  else
    //if not (Style = bsCheck) then
    begin
      FDown := false;
      FStepHover := 100;
      FTimeInc := -20;
      GlowState := gsHover;
      Invalidate;
    end;

  if not Assigned(FTimer) then
  begin
    FTimer := TTimer.Create(self);
    FTimer.OnTimer := TimerProc;
    FTimer.Interval := GlowSpeed;
    FTimer.Enabled := true;
  end;

end;

procedure TAdvCustomGlowButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TAdvCustomGlowButton.CNCommand(var Message: TWMCommand);
begin
  if Message.NotifyCode = BN_CLICKED then
    Click;
end;

//------------------------------------------------------------------------------

constructor TAdvCustomGlowButton.Create(AOwner: TComponent);
begin
  inherited;
  FTimer := nil;
  FImageIndex := -1;
  DoubleBuffered := true;
  FGroupIndex := 0;
  FState := absUp;
  FStyle := bsButton;
  FTransparent := False;
  FLayout := blGlyphLeft;
  FDropDownButton := False;
  FDropDownPosition := dpRight;
  FDropDownDirection := ddDown;
  FDropDownSplit := true;
  FShowCaption := true;
  FFocusType := ftBorder;
  FShortCutHint := nil;
  FShortCutHintPos := shpTop;
  FShowDisabled := true;
  FOverlappedText := false;
  FSpacing := 2;
  FWordWrap := true;
  FFirstPaint := true;
  FMarginVert := 2;
  FMarginHorz := 2;
  FRounded := true;

  FIPicture := TGDIPPicture.Create;
  FIPicture.OnChange := PictureChanged;

  FIDisabledPicture := TGDIPPicture.Create;
  FIDisabledPicture.OnChange := PictureChanged;
  FIHotPicture := TGDIPPicture.Create;

  ParentFont := true;
  FAppearance := TGlowButtonAppearance.Create;
  FAppearance.OnChange := OnAppearanceChanged;
  FInternalImages := nil;
  FAntiAlias := aaClearType;
  FBorderStyle := bsSingle;