businessskinform.pas

一个用Delpi写的视频聊天的SDK

        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
    cmMinimizeToTray:
      DrawMTImage(Buffer.Canvas, IX, IY, IC);
    cmClose:
      DrawCloseImage(Buffer.Canvas, IX, IY, IC);
    cmMaximize:
      if Parent.WindowState = wsMaximized
      then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
      else DrawMaximizeImage(Buffer.Canvas, IX, IY, IC);
    cmMinimize:
      if Parent.WindowState = wsMinimized
      then DrawRestoreImage(Buffer.Canvas, IX, IY, IC)
      else DrawMinimizeImage(Buffer.Canvas, IX, IY, IC);
    cmRollUp:
      if Parent.RollUpState
      then DrawRestoreRollUpImage(Buffer.Canvas, IX, IY, IC)
      else DrawRollUpImage(Buffer.Canvas, IX, IY, IC);
    cmSysMenu:
      DrawSysMenuImage(Buffer.Canvas, IX, IY, IC);
  end;
  Cnvs.Draw(ObjectRect.Left, ObjectRect.Top, Buffer);
  Buffer.Free;
end;

procedure TbsSkinStdButtonObject.Draw;

procedure CreateRestoreObjectImage(B: TBitMap; AActive: Boolean);
begin
  B.Width := RectWidth(ObjectRect);
  B.Height := RectHeight(ObjectRect);
  with B.Canvas do
  begin
    if AActive
    then
      CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, RestoreActiveRect)
    else
      CopyRect(Rect(0, 0, B.Width, B.Height), ActivePicture.Canvas, RestoreRect);
  end;
end;

var
  PBuffer, APBuffer: TbsEffectBmp;
  Buffer, ABuffer: TBitMap;
  ASR, SR: TRect;
  FRestoreMode: Boolean;
begin
  if not FSkinSupport
  then
    begin
      DefaultDraw(Cnvs);
      Exit;
    end;

  if (not Enabled) or
     (Enabled and (not Parent.GetFormActive) and (not IsNullRect(InActiveSkinRect)))
  then
    begin
      inherited;
      Exit;
    end;

  if (Command = cmSysMenu) and Parent.FShowIcon and SkinRectInAPicture
  then
    begin
      Parent.DrawFormIcon(Cnvs, ObjectRect.Left, ObjectRect.Top);
      FMorphKf := 0;
      Exit;
    end;

    
  FRestoreMode := False;
  case Command of
    cmMaximize:
      if Parent.WindowState = wsMaximized
      then FRestoreMode := True;
    cmMinimize:
      if Parent.WindowState = wsMinimized
      then FRestoreMode := True;
    cmRollUp:
      if Parent.RollUpState
      then FRestoreMode := True;
  end;
  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;
    if (Parent.SkinData <> nil) and (Parent.SkinData.ResourceStrData <> nil)
    then
      Font.CharSet := Parent.SkinData.ResourceStrData.Charset
    else
      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,