rm_tb97.pas

进销存·完整的·有数据库的·非常完整·只得参考

  const Clip: HRGN);

  procedure DrawLine(const DC: HDC; const X1, Y1, X2, Y2: Integer);
  begin
    MoveToEx(DC, X1, Y1, nil); LineTo(DC, X2, Y2);
  end;
var
  RW, R, R2, RC: TRect;
  DC: HDC;
  HighlightPen, ShadowPen, SavePen: HPEN;
  FillBrush: HBRUSH;
label 1;
begin
  { This works around WM_NCPAINT problem described at top of source code }
  {no!  R := Rect(0, 0, Width, Height);}
  GetWindowRect(Handle, RW);
  R := RW;
  OffsetRect(R, -R.Left, -R.Top);

  if not DrawToDC then
    DC := GetWindowDC(Handle)
  else
    DC := ADC;
  try
    { Use update region }
    if not DrawToDC then
      SelectNCUpdateRgn(Handle, DC, Clip);

    { Draw BoundLines }
    R2 := R;
    if (BoundLines <> []) and
      ((csDesigning in ComponentState) or HasVisibleToolbars) then begin
      HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
      ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
      SavePen := SelectObject(DC, ShadowPen);
      if blTop in BoundLines then begin
        DrawLine(DC, R.Left, R.Top, R.Right, R.Top);
        Inc(R2.Top);
      end;
      if blLeft in BoundLines then begin
        DrawLine(DC, R.Left, R.Top, R.Left, R.Bottom);
        Inc(R2.Left);
      end;
      SelectObject(DC, HighlightPen);
      if blBottom in BoundLines then begin
        DrawLine(DC, R.Left, R.Bottom - 1, R.Right, R.Bottom - 1);
        Dec(R2.Bottom);
      end;
      if blRight in BoundLines then begin
        DrawLine(DC, R.Right - 1, R.Top, R.Right - 1, R.Bottom);
        Dec(R2.Right);
      end;
      SelectObject(DC, SavePen);
      DeleteObject(ShadowPen);
      DeleteObject(HighlightPen);
    end;
    Windows.GetClientRect(Handle, RC);
    if not IsRectEmpty(RC) then begin
      { ^ ExcludeClipRect can't be passed rectangles that have (Bottom < Top) or
        (Right < Left) since it doesn't treat them as empty }
      MapWindowPoints(Handle, 0, RC, 2);
      OffsetRect(RC, -RW.Left, -RW.Top);
      if EqualRect(RC, R2) then
        { Skip FillRect because there would be nothing left after ExcludeClipRect }
        goto 1;
      ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
    end;
    FillBrush := CreateSolidBrush(ColorToRGB(Color));
    FillRect(DC, R2, FillBrush);
    DeleteObject(FillBrush);
    1:
  finally
    if not DrawToDC then
      ReleaseDC(Handle, DC);
  end;
end;

procedure TDock97.WMNCPaint(var Message: TMessage);
begin
  DrawNCArea(False, 0, HRGN(Message.WParam));
end;

procedure DockNCPaintProc(Wnd: HWND; DC: HDC; AppData: Longint);
begin
  TDock97(AppData).DrawNCArea(True, DC, 0);
end;

procedure TDock97.WMPrint(var Message: TMessage);
begin
  HandleWMPrint(Handle, Message, DockNCPaintProc, Longint(Self));
end;

procedure TDock97.WMPrintClient(var Message: TMessage);
begin
  HandleWMPrintClient(Self, Message);
end;

procedure TDock97.CMColorChanged(var Message: TMessage);
begin
  if UsingBackground then
    { Erase the cache }
    BackgroundChanged(FBkg);
  inherited;
end;

procedure TDock97.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  if UsingBackground then
    { Erase the cache }
    BackgroundChanged(FBkg);
end;

{ TDock97 - property access methods }

procedure TDock97.SetAllowDrag(Value: Boolean);
var
  I: Integer;
begin
  if FAllowDrag <> Value then begin
    FAllowDrag := Value;
    for I := 0 to ControlCount - 1 do
      if Controls[I] is TCustomToolWindow97 then
        RecalcNCArea(TCustomToolWindow97(Controls[I]));
  end;
end;

procedure TDock97.SetBackground(Value: TBitmap);
begin
  FBkg.Assign(Value);
end;

function TDock97.UsingBackground: Boolean;
begin
  Result := (FBkg.Width <> 0) and (FBkg.Height <> 0);
end;

procedure TDock97.InvalidateBackgrounds;
{ Called after background is changed }
var
  I: Integer;
  T: TCustomToolWindow97;
begin
  Invalidate;
  { Synchronize child toolbars also }
  for I := 0 to DockList.Count - 1 do begin
    T := TCustomToolWindow97(DockList[I]);
    with T do
      if ToolbarVisibleOnDock(T) then begin
        InvalidateDockedNCArea;
        Invalidate;
      end;
  end;
end;

procedure TDock97.BackgroundChanged(Sender: TObject);
begin
  { Erase the cache }
  FBkgCache.Free;
  FBkgCache := nil;
  InvalidateBackgrounds;
end;

procedure TDock97.SetBackgroundOnToolbars(Value: Boolean);
begin
  if FBkgOnToolbars <> Value then begin
    FBkgOnToolbars := Value;
    InvalidateBackgrounds;
  end;
end;

procedure TDock97.SetBackgroundTransparent(Value: Boolean);
begin
  if FBkgTransparent <> Value then begin
    FBkgTransparent := Value;
    if UsingBackground then
      { Erase the cache }
      BackgroundChanged(FBkg);
  end;
end;

procedure TDock97.SetBoundLines(Value: TDockBoundLines);
var
  X, Y: Integer;
  B: TDockBoundLines;
begin
  if FBoundLines <> Value then begin
    FBoundLines := Value;
    X := 0;
    Y := 0;
    B := BoundLines; { optimization }
    if blTop in B then Inc(Y);
    if blBottom in B then Inc(Y);
    if blLeft in B then Inc(X);
    if blRight in B then Inc(X);
    FNonClientWidth := X;
    FNonClientHeight := Y;
    RecalcNCArea(Self);
  end;
end;

procedure TDock97.SetFixAlign(Value: Boolean);
begin
  if FFixAlign <> Value then begin
    FFixAlign := Value;
    ArrangeToolbars(False);
  end;
end;

procedure TDock97.SetPosition(Value: TDockPosition);
begin
  if (FPosition <> Value) and (ControlCount <> 0) then
    raise EInvalidOperation.Create(STB97DockCannotChangePosition);
  FPosition := Value;
  case Position of
    dpTop: Align := alTop;
    dpBottom: Align := alBottom;
    dpLeft: Align := alLeft;
    dpRight: Align := alRight;
  end;
end;

function TDock97.GetToolbarCount: Integer;
begin
  Result := DockVisibleList.Count;
end;

function TDock97.GetToolbars(Index: Integer): TCustomToolWindow97;
begin
  Result := TCustomToolWindow97(DockVisibleList[Index]);
end;

function TDock97.GetVersion: TToolbar97Version;
begin
  Result := Toolbar97VersionPropText;
end;

procedure TDock97.SetVersion(const Value: TToolbar97Version);
begin
  { write method required for the property to show up in Object Inspector }
end;


{ TFloatingWindowParent - Internal }

constructor TFloatingWindowParent.Create(AOwner: TComponent);
begin
  { Don't use TForm's Create since it attempts to load a form resource, which
    TFloatingWindowParent doesn't have. }
  CreateNew(AOwner{$IFDEF VER93}, 0{$ENDIF});
end;

procedure TFloatingWindowParent.CreateParams(var Params: TCreateParams);
begin
  inherited;
  { The WS_EX_TOOLWINDOW style is needed to prevent the form from having
    a taskbar button when Toolbar97 is used in a DLL or OCX. }
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW;
end;

procedure TFloatingWindowParent.CMShowingChanged(var Message: TMessage);
const
  ShowFlags: array[Boolean] of UINT = (
    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
begin
  { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the
    form doesn't get activated when Visible is set to True. }
  SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing and FShouldShow]);
end;

procedure TFloatingWindowParent.CMDialogKey(var Message: TCMDialogKey);
begin
  { If Escape if pressed on a floating toolbar, return focus to the form }
  if (Message.CharCode = VK_ESCAPE) and (KeyDataToShiftState(Message.KeyData) = []) and
    Assigned(ParentForm) then begin
    ParentForm.SetFocus;
    Message.Result := 1;
  end
  else
    inherited;
end;


{ Global procedures }

procedure CustomLoadToolbarPositions(const Form: {$IFDEF TB97D3}TCustomForm{$ELSE}TForm{$ENDIF};
  const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
var
  Rev: Integer;

  function FindDock(AName: string): TDock97;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to Form.ComponentCount - 1 do
      if (Form.Components[I] is TDock97) and (Form.Components[I].Name = AName) then begin
        Result := TDock97(Form.Components[I]);
        Break;
      end;
  end;
  procedure ReadValues(const Toolbar: TCustomToolWindow97; const NewDock: TDock97);
  var
    Pos: TPoint;
    LastDockName: string;
    ADock: TDock97;
  begin
    with Toolbar do begin
      DockRow := ReadIntProc(Name, rvDockRow, DockRow, ExtraData);
      DockPos := ReadIntProc(Name, rvDockPos, DockPos, ExtraData);
      Pos.X := ReadIntProc(Name, rvFloatLeft, 0, ExtraData);
      Pos.Y := ReadIntProc(Name, rvFloatTop, 0, ExtraData);
      ReadPositionData(ReadIntProc, ReadStringProc, ExtraData);
      FFloatingTopLeft := Pos;
      if Assigned(NewDock) then
        Parent := NewDock
      else begin
        Parent := Form;
        SetBounds(Pos.X, Pos.Y, Width, Height);
        MoveOnScreen(True);
        if (Rev >= 3) and FUseLastDock then begin
          LastDockName := ReadStringProc(Name, rvLastDock, '', ExtraData);
          if LastDockName <> '' then begin
            ADock := FindDock(LastDockName);
            if Assigned(ADock) then
              LastDock := ADock;
          end;
        end;
      end;
      ArrangeControls;
      DoneReadingPositionData(ReadIntProc, ReadStringProc, ExtraData);
    end;
  end;
var
  DocksDisabled: TList;
  I: Integer;
  ToolWindow: TComponent;
  ADock: TDock97;
  DockedToName: string;
begin
  DocksDisabled := TList.Create;
  try
    with Form do
      for I := 0 to ComponentCount - 1 do
        if Components[I] is TDock97 then begin
          TDock97(Components[I]).BeginUpdate;
          DocksDisabled.Add(Components[I]);
        end;

    for I := 0 to Form.ComponentCount - 1 do begin
      ToolWindow := Form.Components[I];
      if ToolWindow is TCustomToolWindow97 then
        with TC