businessskinform.pas

布林电话收费管理系统

              Buffer := TBitMap.Create;
              ABuffer := TBitMap.Create;
              CreateRestoreObjectImage(Buffer, False);
              CreateRestoreObjectImage(ABuffer, True);
              PBuffer := TbsEffectBmp.CreateFromhWnd(Buffer.Handle);
              APBuffer := TbsEffectBmp.CreateFromhWnd(ABuffer.Handle);
              case MorphKind of
                mkDefault: PBuffer.Morph(APBuffer, MorphKf);
                mkGradient: PBuffer.MorphGrad(APBuffer, MorphKf);
                mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, MorphKf);
                mkRightGradient: PBuffer.MorphRightGrad(APBuffer, MorphKf);
                mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, MorphKf);
                mkRightSlide: PBuffer.MorphRightSlide(APBuffer, MorphKf);
                mkPush: PBuffer.MorphPush(APBuffer, MorphKf)
              end;
              PBuffer.Draw(Cnvs.Handle, ObjectRect.Left, ObjectRect.Top);
              PBuffer.Free;
              APBuffer.Free;
              Buffer.Free;
              ABuffer.Free;
            end;
        end;
    end;
end;

procedure TbsSkinStdButtonObject.DoMax;
begin
  if Parent.WindowState = wsMaximized
  then Parent.WindowState := wsNormal
  else Parent.WindowState := wsMaximized;
end;

procedure TbsSkinStdButtonObject.DoMin;
begin
  if Parent.WindowState = wsMinimized
  then Parent.WindowState := wsNormal
  else Parent.WindowState := wsMinimized;
end;

procedure TbsSkinStdButtonObject.DoClose;
begin
  Parent.FForm.Close;
end;

procedure TbsSkinStdButtonObject.DoRollUp;
begin
  Parent.RollUpState := not Parent.RollUpState;
end;

procedure TbsSkinStdButtonObject.DoCommand;
begin
  case Command of
    cmClose: DoClose;
    cmMinimize: DoMin;
    cmMaximize: DoMax;
    cmRollUp: DoRollUp;
  end;
end;

procedure TbsSkinStdButtonObject.DblClick;
begin
  if Command = cmSysMenu then DoClose;
end;

procedure TbsSkinStdButtonObject.MouseDown;
begin
  if not Enabled then Exit;
  if (Button = mbLeft) and not FDown
  then
    begin
      SetDown(True);
      if (Command = cmSysMenu)
      then
        begin
          Self.MenuItem := Parent.GetSystemMenu;
          TrackMenu;
        end;
    end;
end;

procedure TbsSkinStdButtonObject.MouseUp;
begin
  if (Command = cmClose)
  then
    begin
      inherited;
      if Active and (Button = mbLeft) then DoCommand;
    end
  else
    begin
      if Active and (Button = mbLeft) then DoCommand;
      inherited;
    end;
end;

//============= TbsSkinCaptionObject ==================//

constructor TbsSkinCaptionObject.Create;
begin
  inherited Create(AParent, AData);
  with TbsDataSkinCaption(AData) do
  begin
    Self.FontName := FontName;
    Self.FontStyle := FontStyle;
    Self.FontHeight := FontHeight;
    Self.FontColor := FontColor;
    Self.ActiveFontColor := ActiveFontColor;
    Self.Alignment := Alignment;
    Self.TextRct := TextRct;
    Self.Shadow := Shadow;
    Self.ShadowColor := ShadowColor;
    Self.ActiveShadowColor := ActiveShadowColor;
    Self.FrameRect := FrameRect;
    Self.ActiveFrameRect := ActiveFrameRect;
    Self.FrameLeftOffset := FrameLeftOffset; 
    Self.FrameRightOffset := FrameRightOffset;
    Self.FrameTextRect := FrameTextRect; 
  end;
end;

procedure TbsSkinCaptionObject.MouseDown;
begin
  with Parent do
  begin
    MouseDownEvent(IDName, X, Y, ObjectRect, Button);
  end;
end;

procedure TbsSkinCaptionObject.MouseUp;
begin
  with Parent do
  begin
    MouseUpEvent(IDName, X, Y, ObjectRect, Button);
  end;
end;

procedure TbsSkinCaptionObject.MouseEnter;
begin
  FMouseIn := True;
  Parent.MouseEnterEvent(IDName);
end;

procedure TbsSkinCaptionObject.MouseLeave;
begin
  FMouseIn := False;
  Parent.MouseLeaveEvent(IDName);
end;

procedure TbsSkinCaptionObject.Draw;
var
  Image, ActiveImage: TBitMap;
  EB1, EB2: TbsEffectBmp;
  tx, ty: Integer;
  RealTextRect: TRect;
  SR, ASR: TRect;

procedure CnvSetFont(Cnv: TCanvas; FColor: TColor);
begin
  with Cnv do
  begin
    Font.Name := FontName;
    Font.Style := FontStyle;
    Font.Height := FontHeight;
    Font.Color := FColor;
    Font.CharSet := Parent.DefCaptionFont.Charset;
  end;
end;

function CorrectText(Cnv: TCanvas; var S1: String): String;
var
  w: Integer;
  S: String;
begin
  S := S1;
  w := RectWidth(RealTextRect);
  Parent.CorrectCaptionText(Cnv, S, w);
  Result := S;
end;

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;