cdibpanel.pas

Delphi控件

    end;

  if (TWinControl(Message.Sender) = Self) then 
  begin
    if DIBGetLast is TWincontrol then 
    begin
      GetKeyboardState(KS);
      if KS[VK_SHIFT] and 128 = 128 then DIBSelectPrior;
    end;
  end 
  else
    DIBFocusControl(nil);
end;

procedure TCustomDIBContainer.CNChar(var Message: TWMKey);
begin
  if ChildWantsKey(Message) then 
  begin
    Message.Result := FActiveControl.Perform(WM_Char, TMessage(Message).WParam,
      TMessage(Message).LParam);
    exit;
  end;
end;

procedure TCustomDIBContainer.CNKeyDown(var Message: TWMKeyDown);
var
  KS: TKeyboardState;
  Handled: Boolean;
begin
  if ChildWantsKey(Message) then 
  begin
    Message.Result := FActiveControl.Perform(WM_KeyDown, TMessage(Message).WParam,
      TMessage(Message).LParam);
    exit;
  end;

  if (Screen.ActiveControl = DIBGetLast) then
  begin
    inherited;
    exit;
  end;

  Handled := False;
  if Message.CharCode = VK_TAB then
    try
      FTabbing := True;
      GetKeyboardState(KS);
      if KS[VK_SHIFT] and 128 = 128 then
        Handled := DIBSelectPrior
      else
        Handled := DIBSelectNext
      finally
        FTabbing := False;
    end;

  if not Handled then 
  begin
    inherited;
    if Screen.ActiveControl = Self then DoEnter;
  end;
end;

procedure TCustomDIBContainer.CNKeyUp(var Message: TWMKeyUp);
begin
  if ChildWantsKey(Message) then 
  begin
    Message.Result := FActiveControl.Perform(WM_KeyUp, TMessage(Message).WParam,
      TMessage(Message).LParam);
    exit;
  end;
end;

constructor TCustomDIBContainer.Create(AOwner: TComponent);
begin
  inherited;
  FTabList := TList.Create;
  ControlStyle := ControlStyle + [csAcceptsControls];
  FDIB := TWinDib.Create;
  FChildDIB := TWinDIB.Create;
  DoubleBuffered := True;
  TabStop := False;
  FActiveControl := nil;
  FChangingFocus := False;
  FTabbing := False;
  BorderWidth := 0;
  BorderStyle := bsNone;
  BevelOuter := bvNone;
  FPalette := nil;
  FAlteredRect := False;
  BorderStyle := bsNone;
end;

procedure TCustomDIBContainer.CreateParams(var Params: TCreateParams);
begin
  inherited;
end;

destructor TCustomDIBContainer.Destroy;
begin
  FTabList.Free;
  FChildDIB.Free;
  FDIB.Free;
  inherited;
end;

function TCustomDIBContainer.DIBFindNext(aControl: TControl;
  aForward: Boolean): TControl;
var
  I, StartIndex: Integer;
begin
  Result := nil;

  if FTabList.Count > 0 then 
  begin
    StartIndex := FTabList.IndexOf(aControl);
    if StartIndex = -1 then
      if aForward then
        StartIndex := FTabList.Count - 1
      else
        StartIndex := 0;

    I := StartIndex;
    repeat
      if aForward then 
      begin
        Inc(I);
        if I = FTabList.Count then I := 0;
      end 
      else 
      begin
        if I = 0 then I := FTabList.Count;
        Dec(I);
      end;

      aControl := FTabList[I];
      if aControl.Enabled then Result := aControl;
    until (Result <> nil) or (I = StartIndex);
  end;
end;

procedure TCustomDIBContainer.DIBFocusControl(aControl: TControl);
begin
  if FChangingFocus then exit;
  FChangingFocus := True;
  try
    if aControl <> FActiveControl then
      if FActiveControl <> nil then
        FActiveControl.Perform(WM_KillFocus, 0, 0);

    FActiveControl := aControl;
    if aControl <> nil then FActiveControl.Perform(WM_SetFocus, 0, 0);
    if Assigned(FOnActiveControlChange) then
      FOnActiveControlChange(Self);
  finally
    FChangingFocus := False;
  end;
end;

function TCustomDIBContainer.DIBGetFirst: TControl;
begin
  Result := nil;
  if FTabList.Count > 0 then Result := TControl(FTabList[0]);

  if Result = nil then 
  begin
    Result := FindNextControl(Self, True, True, True);
    if Result <> nil then
      if Result.Parent <> self then
        Result := nil;
  end;
end;

function TCustomDIBContainer.DIBGetIndex(aControl: TControl): Integer;
begin
  Result := -1;
  if aControl is TWinControl then 
  begin
    if aControl.Parent = Self then
      Result := TWinControl(aControl).TabOrder + ControlCount;
  end 
  else 
  begin
    Result := FTabList.IndexOf(aControl);
  end;
end;

function TCustomDIBContainer.DIBGetLast: TControl;
var
  OrderList: TList;
begin
  Result := nil;
  OrderList := TList.Create;
  try
    GetTabOrderList(OrderList);
    if OrderList.Count > 0 then
      Result := OrderList[OrderList.Count - 1]
    else if FTabList.Count > 0 then
      Result := FTabList[FTabList.Count - 1];
  finally
    OrderList.Free;
  end;
end;

function TCustomDIBContainer.DIBGetNext: TControl;
begin
  Result := nil;
  if not (FActiveControl is TWinControl) then 
  begin
    Result := DIBFindNext(FActiveControl, True);
    if DIBGetIndex(Result) < DIBGetIndex(FActiveControl) then Result := nil;
  end;

  if (FActiveControl is TWinControl) or (Result = nil) then 
  begin
    if Result = nil then
      Result := FindNextControl(Self, True, True, True)
    else
      Result := FindNextControl(TWinControl(FActiveControl), True, True, True);
    if Result <> nil then
      if (Result.Parent <> self) or (DIBGetIndex(Result) < DIBGetIndex(FActiveControl)) then
        Result := nil;
  end;

  if DIBGetIndex(Result) < DIBGetIndex(FActiveControl) then Result := nil;
end;

function TCustomDIBContainer.DIBGetPrior: TControl;
begin
  Result := nil;
  if (FActiveControl is TWinControl) or (Result = nil) then 
  begin
    //Look backwards
    Result := FindNextControl(TWinControl(FActiveControl), False, True, True);
    if Result <> nil then
      if (Result.Parent <> self) then Result := nil;
  end;

  if (DIBGetIndex(Result) > DIBGetIndex(FActiveControl)) or
    (DIBGetIndex(Result) = -1) then Result := nil;

  if not (FActiveControl is TWinControl) or (Result = nil) then 
  begin
    //Look backwards
    Result := DIBFindNext(FActiveControl, False);
    if (DIBGetIndex(Result) > DIBGetIndex(FActiveControl)) or
      (DIBGetIndex(Result) = -1) then Result := nil;
  end;

  if (DIBGetIndex(Result) > DIBGetIndex(FActiveControl)) or
    (DIBGetIndex(Result) = -1) then Result := nil;
end;

function TCustomDIBContainer.DIBGetTabOrder(aControl: TControl): TTabOrder;
begin
  Result := FTabList.IndexOf(aControl);
end;

function TCustomDIBContainer.DIBSelectNext: Boolean;
var
  NewControl, OldControl: TControl;
begin
  Result := False;
  OldControl := FActiveControl;

  NewControl := DIBGetNext;


  if NewControl <> nil then
    if DIBGetIndex(NewControl) > DIBGetIndex(OldControl) then
      Result := True;

  ActiveControl := NewControl;
end;

function TCustomDIBContainer.DIBSelectPrior: Boolean;
var
  NewControl, OldControl: TControl;
begin
  Result := False;
  OldControl := FActiveControl;

  NewControl := DIBGetPrior;


  if NewControl <> nil then
    if DIBGetIndex(NewControl) < DIBGetIndex(OldControl) then
      if DIBGetIndex(NewControl) <> -1 then
        Result := True;

  ActiveControl := NewControl;
end;

procedure TCustomDIBContainer.DIBSetTabOrder(aControl: TControl;
  NewIndex: TTabOrder);
var
  OldIndex: TTabOrder;
begin
  if aControl = nil then exit;
  OldIndex := FTabList.IndexOf(aControl);
  if OldIndex = NewIndex then exit;

  if (OldIndex >= 0) then FTabList.Delete(OldIndex);
  if NewIndex >= FTabList.Count then
    FTabList.Add(aControl)
  else if NewIndex >= 0 then
    FTabList.Insert(NewIndex, aControl);
  TabStop := FTabList.Count > 0;
end;

procedure TCustomDIBContainer.DoEnter;
var
  KS: TKeyboardState;
  NextControl: TControl;
begin
  if FActiveControl = nil then
    if FTabList.Count > 0 then 
    begin
      GetKeyboardState(KS);
      if (KS[VK_SHIFT] and 128) = 128 then
        NextControl := DIBGetLast
      else
        NextControl := DIBGetFirst;

      DIBFocusControl(NextControl);
      if Assigned(OnEnter) then OnEnter(Self);
    end 
    else
      inherited;
end;

procedure TCustomDIBContainer.DoExit;
begin
  DIBFocusControl(nil);
  inherited;
end;

procedure TCustomDIBContainer.DoTabFixups;
var
  List: array of Pointer;
  CC, X: Integer;
begin
  CC := ControlCount;
  SetLength(List, CC);
  for X := 0 to CC - 1 do List[X] := nil;
  for X := 0 to CC - 1 do
    if Controls[X] is TCustomDIBControl then
      with THackDIBControl(Controls[X]) do
        if FTabOrder <> -1 then
          if FTabOrder < CC then
            List[FTabOrder] := Controls[X]
      else 
      begin
        CC := FTabOrder + 1;
    SetLength(List, FTabOrder);
    List[FTabOrder] := Controls[X];
  end;

  for X := 0 to CC - 1 do
    if List[X] <> nil then DIBSetTabOrder(List[X], X);
end;

procedure TCustomDIBContainer.Loaded;
var
  R: TRect;
begin
  inherited;
  FDIB.Resize(Width, Height);
  DoTabFixups;
  R := ClientRect;
  AlignControls(nil, R);
end;

procedure TCustomDIBContainer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (AComponent = self) or (csDestroying in ComponentState) then exit;

  if aComponent is TDIBPalette then 
  begin
    if Operation = opInsert then
      FPalette := TDIBPalette(AComponent);
    if (Operation = opRemove) and (FPalette = AComponent) then
      FPalette := nil;
  end;
  if (Operation = opRemove) then
  begin
    if AComponent is TControl then DIBSetTabOrder(TControl(aComponent), - 1);
    if AComponent = DIBBorder then DIBBorder := nil;
  end;
end;

procedure TCustomDIBContainer.Paint;
begin
  if (FUpdateRect.Left = 0) and (FUpdateRect.Top = 0) and
    (FUpdateRect.Right = Width) and (FUpdateRect.Bottom = Height) then
    FDIB.QuickFill(ColorToRGB(Self.Color))
  else
    with FUpdateRect do
      FDIB.QuickFillRect(ColorToRGB(Self.Color), Left, Top, Right - Left, Bottom - Top);
end;

procedure TCustomDIBContainer.PaintControls(DC: HDC; First: TControl);
var
  CurrentControlIndex, FindControlIndex, SaveIndex: Integer;
  CurrentControl: TControl;
  FrameBrush: HBRUSH;
  D: TRect;
begin
  if BorderDrawPosition = bdUnderControls then
    if DIBBorder <> nil then DIBBorder.DrawTo(DIB, ClientRect);
  if DockSite and UseDockManager and (DockManager <> nil) then
    DockManager.PaintSite(DC);
  if ControlCount > 0 then
  begin
    //Do non-wincontrols
    if First <> nil then
    begin
      for FindControlIndex := ControlCount - 1 downto 0 do
        if Controls[FindControlIndex] = First then
        begin
          CurrentControlIndex := FindControlIndex;
          Break;
        end;
    end else
      CurrentControlIndex := 0;
      
    for CurrentControlIndex := CurrentControlIndex to ControlCount - 1do