businessskinform.pas

Delphi开发的图象处理软件

  if IsNullRect(RestoreRect) or not FRestoreMode
  then
    inherited
  else
    begin
      if not Parent.GetFormActive and not IsNullRect(RestoreInActiveRect)
      then
        Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, RestoreInActiveRect)
      else
      if FDown and not IsNullRect(RestoreDownRect) and FMouseIn
      then
        Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, RestoreDownRect)
      else
        begin
          ASR := RestoreActiveRect;
          SR := RestoreRect;
          if not Morphing or
          ((Active and (MorphKf = 1)) or (not Active and (MorphKf  = 0)))
          then
            begin
              if Active and not IsNullRect(ASR)
              then
                Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, ASR)
              else
                Cnvs.CopyRect(ObjectRect, ActivePicture.Canvas, SR);
            end
          else
            begin
              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.DoMinimizeToTray;
begin
  Parent.MinimizeToTray;
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
    cmMinimizeToTray: DoMinimizeToTray;
    cmClose: DoClose;
    cmMinimize:
      if Parent.AlwaysMinimizeToTray
      then
        Parent.MinimizeToTray
      else
        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.Cr