businessskinform.pas

实现网络流量的生成,为cs结构,可以控制流量大小

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 CreateObjectImage(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), Picture.Canvas, ActiveSkinRect)
    else
      CopyRect(Rect(0, 0, B.Width, B.Height), Picture.Canvas, SkinRect);
  end;
end;

var
  PBuffer, APBuffer: TbsEffectBmp;
  Buffer, ABuffer: TBitMap;
  ASR, SR: TRect;
begin
  if not FSkinSupport or (Picture = nil)
  then
    begin
      DefaultDraw(Cnvs);
      Exit;
    end;  
  if (FDown and not IsNullRect(DownRect)) and FMouseIn
  then
    Cnvs.CopyRect(ObjectRect, Picture.Canvas, DownRect)
  else
    begin
      ASR := ActiveSkinRect;
      SR := SkinRect;
      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, Picture.Canvas, ASR)
          else
            Cnvs.CopyRect(ObjectRect, Picture.Canvas, SR);
        end
      else
        begin
          Buffer := TBitMap.Create;
          ABuffer := TBitMap.Create;
          CreateObjectImage(Buffer, False);
          CreateObjectImage(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;

procedure TbsSkinMainMenuBarButton.DblClick;
var
  DS: TbsBusinessSkinForm;
begin
  DS := GetMDIChildBusinessSkinFormComponent;
  if (DS <> nil) and (Command = cmSysMenu)
  then
    begin
      Parent.BSF.SkinMenu.Hide;
      Parent.BSF.SkinMenuClose;
      DS.FForm.Close;
    end;  
end;

procedure TbsSkinMainMenuBarButton.DoCommand;
var
  DS: TbsBusinessSkinForm;
  MI: TMenuItem;
  R: TRect;
  P: TPoint;
begin
  DS := GetMDIChildBusinessSkinFormComponent;
  if DS <> nil
  then
    case Command of
      cmClose: DS.FForm.Close;
      cmMinimize: DS.WindowState := wsMinimized;
      cmMaximize: DS.WindowState := wsNormal;
      cmSysMenu:
        begin
          Parent.Repaint;
          P := Point(ObjectRect.Left, ObjectRect.Top);
          P := Parent.ClientToScreen(P);
          R := Rect(P.X, P.Y, P.X + RectWidth(ObjectRect), P.Y + RectHeight(ObjectRect));
          MI := DS.GetSystemMenu;
          Parent.BSF.SkinMenuOpen;
          if Parent.BSF.MenusSkinData = nil
          then
            Parent.BSF.SkinMenu.Popup(Parent, Parent.BSF.SkinData, 0, R, MI, Parent.PopupToUp)
          else
            Parent.BSF.SkinMenu.Popup(Parent, Parent.BSF.MenusSkinData, 0, R, MI, Parent.PopupToUp);
        end;
   end;
end;

procedure TbsSkinMainMenuBarButton.MouseDown;
begin
  if not Enabled then Exit;
  if (Button <> mbLeft)
  then
    begin
      inherited MouseDown(X, Y, Button);
      Exit;
    end;
  if not FDown
  then
    begin
      FDown := True;
      if Morphing and not IsNullRect(DownRect) then MorphKf := 1;
      Parent.DrawSkinObject(Self);
      if Command = cmSysMenu then DoCommand;
    end;
end;

procedure TbsSkinMainMenuBarButton.MouseUp;
begin
  if not Enabled then Exit;
  if (Button <> mbLeft)
  then
    begin
      inherited MouseUp(X, Y, Button);
      Exit;
    end;
  inherited MouseUp(X, Y, Button);
  if (Command <> cmSysMenu)
  then
    begin
      FDown := False;
      ReDraw;
    end;
  if Active and (Command <> cmSysMenu) then DoCommand;
end;

// ==============TspSkinMainMenuBar =============//
constructor TbsSkinMainMenuBarItem.Create;
begin
  inherited Create(AParent, AData);
  if AData <> nil
  then
    begin
      FSkinSupport := True;
      with TbsDataSkinMainMenuBarItem(AData) do
      begin
        Self.FontName := FontName;
        Self.FontHeight := FontHeight;
        Self.FontStyle := FontStyle;
        Self.FontColor := FontColor;
        Self.ActiveFontColor := ActiveFontColor;
        Self.DownFontColor := DownFontColor;
        Self.TextRct := TextRct;
        Self.DownRect := DownRect;
        Self.LO := ItemLO;
        Self.RO := ItemRO;
        Self.UnEnabledFontColor := UnEnabledFontColor;
      end;
      if IsNullRect(DownRect) then
      if IsNullRect(ActiveSkinRect)
      then DownRect := SkinRect else DownRect := ActiveSkinRect;
      if IsNullRect(ActiveSkinRect) then Morphing := False;
    end
  else
    FSkinSupport := False;
  OldEnabled := Enabled;
  Visible := True;
end;

procedure TbsSkinMainMenuBarItem.SearchActive;
var
  i: Integer;
begin
  for i := 0 to Parent.ObjectList.Count - 1 do
   if (TbsMenuBarObject(Parent.ObjectList.Items[i]) is TbsSkinMainMenuBarItem)
      and (TbsSkinMainMenuBarItem(Parent.ObjectList.Items[i]).IDName <> IDName)
      and (TbsSkinMainMenuBarItem(Parent.ObjectList.Items[i]).Active)
   then
     begin
       TbsSkinMainMenuBarItem(Parent.ObjectList.Items[i]).MouseLeave;
       Break;
     end;
end;

function TbsSkinMainMenuBarItem.SearchDown;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Parent.ObjectList.Count - 1 do
   if (TbsMenuBarObject(Parent.ObjectList.Items[i]) is TbsSkinMainMenuBarItem)
      and (TbsSkinMainMenuBarItem(Parent.ObjectList.Items[i]).IDName <> IDName)
      and (TbsSkinMainMenuBarItem(Parent.ObjectList.Items[i]).FDown)
   then
     begin
       TbsSkinMainMenuBarItem(Parent.ObjectList.Items[i]).SetDown(False);
       Result := True;
       Break;
     end;
end;

procedure TbsSkinMainMenuBarItem.DefaultDraw;

function CalcObjectRect(Cnvs: TCanvas): TRect;
var
  w, i, j: Integer;
  R, TR: TRect;
begin
  w := 2;
  Cnvs.Font.Assign(Parent.DefItemFont);
  TR := Rect(0, 0, 0, 0);
  DrawText(Cnvs.Handle, PChar(MenuItem.Caption),
    Length(MenuItem.Caption), TR, DT_CALCRECT or DT_CENTER);
  w := w + RectWidth(TR) + 10;
  R := Rect(0, 0, 0, 0);
  j := Parent.ObjectList.IndexOf(Self);
  for i := j - 1  downto 0 do
    if TbsMenuBarObject(Parent.ObjectList.Items[i]) is TbsSkinMainMenuBarItem
    then
      begin
        R.Left := TbsMenuBarObject(Parent.ObjectList.Items[i]).ObjectRect.Right;
        Break;
      end;
  if R.Left = 0 then R.Left := Parent.NewItemsRect.Left;
  R.Top := Parent.NewItemsRect.Top;
  R.Right := R.Left + w;
  R.Bottom := Parent.NewItemsRect.Bottom;
  Resul