businessskinform.pas

漂亮的皮肤控件 for delphi 567

procedure CreateCaptionBitMap(DestB: TBitMap; SourceRect: TRect; SourceB: TBitMap);
var
  X, XCnt: Integer;
  w: Integer;
  R: TRect;
  XO, LO, RO: Integer;
begin
  LO := SD.LTPoint.X - SR.Left;
  RO := SR.Right - SD.RTPoint.X;
  DestB.Width := RectWidth(ObjectRect);
  DestB.Height := RectHeight(ObjectRect);
  R := Rect(SourceRect.Left + LO, SourceRect.Top,
            SourceRect.Right - RO, SourceRect.Bottom);
  if (LO = 0) and (RO = 0)
  then
    DestB.Canvas.CopyRect(Rect(0, 0, DestB.Width, DestB.Height),
                          SourceB.Canvas, R)
  else
    begin
      w := RectWidth(R);
      XCnt := DestB.Width div w;
      for X := 0 to XCnt do
      begin
        if X * w + w > DestB.Width
        then XO := X * w + w - DestB.Width else XO := 0;
        Dec(R.Right, XO);
        DestB.Canvas.CopyRect(Rect(X * w, 0, X * w + w - XO, DestB.Height),
                              SourceB.Canvas, R);
      end;
   end;

  with DestB.Canvas do
  begin
    if LO <> 0
    then
      CopyRect(Rect(0, 0, LO, DestB.Height),
               SourceB.Canvas, Rect(SourceRect.Left, SourceRect.Top,
                                    SourceRect.Left + LO, SourceRect.Bottom));
    if RO <> 0
    then
      CopyRect(Rect(DestB.Width - RO, 0, DestB.Width, DestB.Height),
               SourceB.Canvas, Rect(SourceRect.Right - RO, SourceRect.Top,
                                    SourceRect.Right, SourceRect.Bottom));
  end;

end;

procedure CalcTextCoord(tw, th: Integer);
var
  w, h: Integer;
begin
  w := RectWidth(RealTextRect);
  h := RectHeight(RealTextRect);
  ty := h div 2 - th div 2 + RealTextRect.Top;
  case Alignment of
    taLeftJustify: tx := RealTextRect.Left;
    taRightJustify: tx := RealTextRect.Right - tw;
    taCenter: tx := w div 2 - tw div 2 + RealTextRect.Left;
  end;
end;

procedure DrawCaptionText(Cnv: TCanvas; OX, OY: Integer; AActive: Boolean);
var
  S1: String;
  C: TColor;
  F: TForm;
  B: TBitMap;
  FR: TRect;
begin
  S1 := Parent.FForm.Caption;

  if (Parent.FForm.FormStyle = fsMDIForm) and Parent.IsMDIChildMaximized
  then
    begin
      F := Parent.GetMaximizeMDIChild;
      if F <> nil then S1 := S1 + ' - [' + F.Caption + ']';
    end;

  if (S1 = '') or IsNullRect(TextRct) then Exit;
  S1 := CorrectText(Cnv, S1);
  with Cnv do
  begin
    CalcTextCoord(TextWidth(S1), TextHeight(S1));
    tx := tx + OX;
    ty := ty + OY;
    Brush.Style := bsClear;

    if not IsNullRect(Self.FrameRect)
    then
      begin
        B := TBitMap.Create;
        if (AActive) and not IsNullRect(ActiveFrameRect)
        then FR := ActiveFrameRect
        else FR := Self.FrameRect;
        CreateHSkinImage(FrameLeftOffset, FrameRightOffset, B, ActivePicture, FR,
        TextWidth(S1) + RectWidth(Self.FrameRect) - RectWidth(FrameTextRect),
        RectHeight(Self.FrameRect));
        Draw(TX - FrameTextRect.Left, TY - FrameTextRect.Top, B);
        B.Free;
      end;

    if Shadow
    then
      begin
        Font.Charset := Parent.FDefCaptionFont.Charset;
        C := Font.Color;
        if AActive
        then Font.Color := ActiveShadowColor
        else Font.Color := ShadowColor;
        TextOut(tx + 1, ty + 1, S1);
        Font.Color := C;
      end;

    TextOut(tx, ty, S1);
  end;
end;

var
  TextO: Integer;
begin
  SR := SkinRect;
  ASR := ActiveSkinRect;
  RealTextRect := TextRct;

  if not IsNullRect(TextRct)
  then
    begin
      TextO := RectWidth(SkinRect) - TextRct.Right;
      RealTextRect.Right := RectWidth(ObjectRect) - TextO;
    end;

  if not IsNullRect(FrameRect)
  then
    begin
      Inc(RealTextRect.Top, FrameTextRect.Top);
      Inc(RealTextRect.Left, FrameTextRect.Left);
      Dec(RealTextRect.Right, RectWidth(FrameRect) - FrameTextRect.Right);
    end;

  if Active
  then CnvSetFont(Cnvs, ActiveFontColor)
  else CnvSetFont(Cnvs, FontColor);

  if (((MorphKf > 0) and not Active) or ((MorphKf < 1) and Active)) and Morphing
  then
    begin
      Image := TBitMap.Create;
      CreateCaptionBitMap(Image, SR, Picture);
      CnvSetFont(Image.Canvas, FontColor);
      DrawCaptionText(Image.Canvas, 0, 0, False);
      ActiveImage := TBitMap.Create;
      CreateCaptionBitMap(ActiveImage, ASR, ActivePicture);
      CnvSetFont(ActiveImage.Canvas, ActiveFontColor);
      DrawCaptionText(ActiveImage.Canvas, 0, 0, True);
      EB1 := TbsEffectBmp.CreateFromhWnd(Image.Handle);
      EB2 := TbsEffectBmp.CreateFromhWnd(ActiveImage.Handle);
      case MorphKind of
        mkDefault: EB1.Morph(EB2, MorphKf);
        mkGradient: EB1.MorphGrad(EB2, MorphKf);
        mkLeftGradient: EB1.MorphLeftGrad(EB2, MorphKf);
        mkRightGradient: EB1.MorphRightGrad(EB2, MorphKf);
        mkLeftSlide: EB1.MorphLeftSlide(EB2, MorphKf);
        mkRightSlide: EB1.MorphRightSlide(EB2, MorphKf);
        mkPush: EB1.MorphPush(EB2, MorphKf)
      end;
      if Parent.GetAutoRenderingInActiveImage and not Active
      then
        case Parent.FSD.InActiveEffect of
          ieBrightness:
            EB1.ChangeBrightness(InActiveBrightnessKf);
          ieDarkness:
            EB1.ChangeDarkness(InActiveDarknessKf);
          ieGrayScale:
            EB1.GrayScale;
          ieNoise:
            EB1.AddMonoNoise(InActiveNoiseAmount);
          ieSplitBlur:
            EB1.SplitBlur(1);
          ieInvert:
            EB1.Invert;
        end;
      EB1.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
      EB1.Free;
      EB2.Free;
      Image.Free;
      ActiveImage.Free;
    end
  else
  if IsNullRect(ASR) or (not IsNullRect(ASR) and not Active) and not Morphing
  then
    DrawCaptionText(Cnvs, ObjectRect.Left, ObjectRect.Top, Active)
  else
  if not Active and Morphing
  then
    begin
      Image := TBitMap.Create;
      CreateCaptionBitMap(Image, SR, Picture);
      CnvSetFont(Image.Canvas, FontColor);
      DrawCaptionText(Image.Canvas, 0, 0, False);
      if Parent.GetAutoRenderingInActiveImage
      then
        begin
          EB1 := TbsEffectBmp.CreateFromhWnd(Image.Handle);
          case Parent.FSD.InActiveEffect of
            ieBrightness:
              EB1.ChangeBrightness(InActiveBrightnessKf);
            ieDarkness:
              EB1.ChangeDarkness(InActiveDarknessKf);
            ieGrayScale:
              EB1.GrayScale;
            ieNoise:
              EB1.AddMonoNoise(InActiveNoiseAmount);
            ieSplitBlur:
              EB1.SplitBlur(1);
            ieInvert:
              EB1.Invert;
          end;
          EB1.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
          EB1.Free;
        end
      else
        Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Image);
      Image.Free;
    end
  else
  if Active
  then
    begin
      Image := TBitMap.Create;
      CreateCaptionBitMap(Image, ASR, ActivePicture);
      CnvSetFont(Image.Canvas, ActiveFontColor);
      DrawCaptionText(Image.Canvas, 0, 0, True);
      Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Image);
      Image.Free;
    end;
end;

//============= TbsSkinMainMenu =============//
constructor TbsSkinMainMenu.Create;
begin
  inherited Create(AOwner);
  BSF := nil;
  FSD := nil;
end;

procedure TbsSkinMainMenu.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
// =========== TbsSkinMainMenuBar ==========//

constructor TbsMenuBarObject.Create;
begin
  Parent := AParent;
  Enabled := True;
  Visible := True;
  FMorphKf := 0;
  FDown := False;
  Morphing := False;
  Picture := nil;
  if AData <> nil then
  with AData do
  begin
    Self.IDName := IDName;
    Self.SkinRect := SkinRect;
    Self.ActiveSkinRect := ActiveSkinRect;
    Self.DownRect := ActiveSkinRect;
    Self.Morphing := Morphing;
    Self.MorphKind := MorphKind;
    ObjectRect := SkinRect;
    if (ActivePictureIndex <> - 1) and
       (ActivePictureIndex < Parent.SkinData.FActivePictures.Count)
    then
      Picture := TBitMap(Parent.SkinData.FActivePictures.Items[ActivePictureIndex]);
    if Morphing and IsNullRect(ActiveSkinRect) then Morphing := False;  
  end;
end;

procedure TbsMenuBarObject.DblClick;
begin

end;

procedure TbsMenuBarObject.ReDraw;
begin
  if Morphing
  then Parent.MorphTimer.Enabled := True
  else Parent.DrawSkinObject(Self);
end;

procedure TbsMenuBarObject.MouseDown(X, Y: Integer; Button: TMouseButton);
begin
end;

procedure TbsMenuBarObject.MouseUp(X, Y: Integer; Button: TMouseButton);
begin
end;

procedure TbsMenuBarObject.MouseEnter;
begin
  FMouseIn := True;
  Active := True;
  ReDraw;
end;

procedure TbsMenuBarObject.MouseLeave;
begin
  FMouseIn := False;
  Active := False;
  ReDraw;
end;

function TbsMenuBarObject.CanMorphing;
begin
  Result := not (FDown and not IsNullRect(DownRect)) and
                ((Active and (MorphKf < 1)) or
                (not Active and (MorphKf > 0)));
end;

procedure TbsMenuBarObject.DoMorphing;
begin
  if Active
  then MorphKf := MorphKf + MorphInc
  else MorphKf := MorphKf - MorphInc;
  Draw(Parent.Canvas);
end;

procedure TbsMenuBarObject.Draw;
begin

end;

procedure TbsMenuBarObject.SetMorphKf(Value: Double);
begin
  FMorphKf := Value;
  if FMorphKf < 0 then FMorphKf := 0 else
  if FMorphKf > 1 then FMorphKf := 1;
end;

// ============== TbsSkinMainMenuBarButton ================ //
constructor TbsSkinMainMenuBarButton.Create;
begin
  inherited Create(AParent, AData);
  if AData <> nil
  then
    with TbsDataSkinMainMenuBarButton(AData) do
    begin
      Self.Command := Command;
      Self.DownRect := DownRect;
      FSkinSupport := True;
    end
  else
    FSkinSupport := False;
end;

procedure TbsSkinMainMenuBarButton.DefaultDraw(Cnvs: TCanvas);
var
  Buffer: TBitMap;
  R: TRect;
  IX, IY: Integer;
  IC: TColor;
begin
  Buffer := TBitMap.Create;
  Buffer.Width := RectWidth(ObjectRect);
  Buffer.Height := RectHeight(ObjectRect);
  R := Rect(0, 0, Buffer.Width, Buffer.Height);
  with Buffer.Canvas do
  begin
    if FDown and FMouseIn
    then
      begin
        Frame3D(Buffer.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
        Brush.Color := BS_XP_BTNDOWNCOLOR;
        FillRect(R);
      end
    else
      if FMouseIn
      then
        begin
          Frame3D(Buffer.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
          Brush.Color := BS_XP_BTNACTIVECOLOR;
          FillRect(R);
        end
      else

        begin
          Brush.Color := clBtnFace;
          FillRect(R);
        end;
  end;

  IX := Buffer.Width div 2 - 5;
  IY := Buffer.Height div 2 - 4;
  if FDown and FMouseIn
  then
    begin
      Inc(IX);
      Inc(IY);
    end;
  if Enabled then IC := clBtnText else IC := clBtnShadow;
  case Command of
    cmClose: DrawCloseImage(Buffer.Canvas, IX, IY, IC);
    cmMaximize: DrawRestoreImage(Buffer.Canvas, IX, IY, IC);
    cmMinimize: DrawMinimizeImage(Buffer.Canvas, IX, IY, IC);
    cmSysMenu: DrawSysMenuImage(Buffer.Canvas, IX, IY, IC);
  end;
  Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
  Buffer.Free;
end;

procedure TbsSkinMainMenuBarButton.MouseEnter;
begin
  if (Command = cmSysMenu) and FDown
  then
    begin
      FMouseIn := True;
      Active := True;
    end
  else
    inherited;
end;

procedure TbsSkinMainMenuBarButton.MouseLeave;
begin
  if (Command = cmSysMenu) and FDown
  then
    begin
      if Morphing then FMorphKf := 1;
      Active := False;
      FMouseIn := False;
    end
  else
    inherited;
end;

procedure TbsSkinMainMenuBarButton.Draw;

procedure Cr