wwcheckbox.pas

InfoPower_Studio 2007 v5.0.1.3 banben

  inherited;
end;

procedure TwwDBCustomCheckbox.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

function TwwDBCustomCheckbox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TwwDBCustomCheckbox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;

Function TwwCustomCheckBox.GetCanvas: TCanvas;
begin
   if Focused and (FPaintBitmap<>nil) then
      result:= FPaintCanvas
   else
      result:= FCanvas;
end;

procedure TwwCustomCheckBox.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if key=vk_space then
  begin
     if SpaceKeyPressed then Toggle;
     SpaceKeyPressed:=False;
  end
end;

procedure TwwCustomCheckBox.KeyDown(var Key: Word; Shift: TShiftState);
  procedure SendToParent;
  begin
    Parent.setFocus;
    { If grid does not have focus then SetFocus raised exception }
    if Parent.focused then
       TwwDBGrid(Parent).KeyDown(Key, Shift);
    Key := 0;
  end;
begin
  inherited;
  case key of
     VK_ESCAPE:
       if (parent is TCustomGrid) then
       begin
         if not modified then SendToParent;
       end;
     vk_space :
       begin
         SpaceKeyPressed:=True;
       end
  end;
end;

procedure TwwCustomCheckBox.CNKeyDown(var Message: TWMKeyDown);
begin
  if not (csDesigning in ComponentState) then
  begin
    with Message do
       if (charcode = VK_SPACE) then SpaceKeyPressed:=True;
  end;

  inherited;
end;

procedure TwwCustomCheckBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = Images then Images := nil;
    if (AComponent = FController) then FController:= nil;
  end;
end;

procedure TwwCustomCheckBox.CNCommand(var Message: TWMCommand);
begin
  // Handle toggling ourselves instead of control
  // as when control is in inspector it does not work otherwise
  // Therefore we do not call inherited CNCommand
end;

procedure TwwCustomCheckBox.DoMouseEnter;
begin
  try
     If Assigned( FOnMouseEnter ) Then FOnMouseEnter( self );
  except
    exit;
  end;

  if wwUseThemes(self) then
  begin
     Invalidate;
  end;

  if Frame.IsFrameEffective and (not Focused) and
     Frame.MouseEnterSameAsFocus then
     wwDrawEdge(self, Frame, GetCanvas, True);
end;

procedure TwwCustomCheckBox.DoMouseLeave;
begin
  try
    If Assigned( FOnMouseLeave ) Then FOnMouseLeave( self );
  except
    exit;
  end;
  if wwUseThemes(self) then
  begin
     Invalidate;
  end;

  if Frame.IsFrameEffective and (not Focused) and
     Frame.MouseEnterSameAsFocus then begin
     wwDrawEdge(self, Frame, GetCanvas, False);
     if IsTransparentEffective then
        Frame.CreateTransparent:= True;
     RecreateWnd;
  end;
end;

procedure TwwCustomCheckBox.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  DoMouseEnter;
//  if cslButtonDown in ControlState then
//     Invalidate;
end;

procedure TwwCustomCheckBox.CMMouseLeave(var Message: TMessage);
var r:TRect;
    pt:TPoint;
begin
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  r := ClientRect;
  if (PtInRect(r,pt)) then exit;

  inherited;
  DoMouseLeave;

//  if cslButtonDown in ControlState then Invalidate;
end;

function TwwCustomCheckbox.GetField: TField;
begin
   result:=nil;
end;

procedure TwwCustomCheckbox.EMGetModify(var Message: TMessage);
begin
   If FModified then message.result:=1
   else message.result:=0;
end;

procedure TwwExpandButton.CMExit(var Message: TCMExit);
begin
   inherited;
end;

procedure TwwExpandButton.CMShowingChanged(var Message: TMessage);
begin
   inherited;
end;

procedure TwwExpandButton.DataChange(Sender: TObject);
begin
   if (datasource<>nil) and (datasource.state=dsbrowse)
      and not InClickEvent
      and not InRefreshCalcField then
   begin
      if State <> cbUnchecked then Toggle;
   end
//      state:= cbUnchecked;
end;

function TwwExpandButton.GetFieldState: TCheckBoxState;
begin
   result:= inherited GetFieldState;
   if (csPaintCopy in ControlState) then
   begin
      Result:= cbUnchecked;
      if (parent is TCustomGrid) and
         (Grid<>nil) and Grid.visible and PaintAsExpanded then
         Result:= cbChecked;
   end;

// Return cbChecked if child grid is visible and
// this is the active column, row
end;

procedure TwwExpandButton.Toggle;
var OrigChecked: boolean;
//    TempCol, TempRow: integer;
begin
  if InToggle then exit;

  OrigChecked:= Checked;
  InToggle:=True;
  try
    // 6/1/01 - Prevent grid's custom edit from moving beyond grid boundaries
    if wwIsClass(parent.classtype, 'TwwDBGrid') then
       TwwDBGrid(Parent).SkipHideControls:= True;

    if Checked then DoBeforeCollapse
    else DoBeforeExpand;

    if (OrigChecked=Checked) then
    begin
       case State of
         cbUnchecked:
          if AllowGrayed then State := cbGrayed
          else begin
             if Parent is TwwDBGrid then with TwwDBGrid(parent) do
             begin
                if RowHeightPercent<>MinRowHeightPercent then
                begin
                   RestoreRowHeights;
                   Update;  // Updates our position
                end
             end;
             State := cbChecked;
          end;
         cbChecked: State := cbUnchecked;
         cbGrayed: State := cbChecked;
       end;
    end;

    if Checked then DoAfterExpand
    else DoAfterCollapse;

  finally
     InToggle:=False;
     TwwDBGrid(Parent).SkipHideControls:= False;
  end
end;

procedure TwwExpandButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FGrid<>nil) and
    (AComponent = FGrid) then FGrid := nil;
end;

function TwwCustomCheckBox.FillBackground: boolean;
begin
   result:= True;
end;

function TwwExpandButton.FillBackground: boolean;
begin
   result:= not checked;
end;

procedure TwwExpandButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
   if ((parent is TCustomGrid) and (not Focused)) then
     message.result:=1
   else inherited;
end;

procedure TwwExpandButton.WMLButtonUp(var Message: TWMLButtonUp);
begin
   inherited;
end;

procedure TwwExpandButton.Click;
var parentGrid: TwwDBGrid;
    p: TPoint;
//    RowsNeeded: integer;
    SpaceAvailable, SpaceNeeded: integer;
    ShiftAmount: integer;
    DefaultRowHeight: integer;
//    BorderOffset, TitleOffset: integer;
    TerminalNode: boolean;
    i: integer;
    TrueScrollAmount: integer;
//    OrigShiftAmount: integer;
    OrigDesiredRow: integer;
    SkipSetTop: boolean;
    ParentParentGrid: TwwDBGrid;
    DesiredRowHeightParent: integer;
    r: TRect;
    TempDesiredRow: integer;
    OrigActiveRecord: integer;
    ParentForm: TCustomForm;
//    NegativeScrollAmount: integer;
//    OldRowCount: integer;

  procedure ClearHorzRange;
  begin
    if TDrawGrid(Grid).ScrollBars in [ssHorizontal, ssBoth] then
      SetScrollRange(Grid.Handle, SB_HORZ, 0, 0, True);
  end;

  procedure SetRow(val: integer);
  var DrawInfo: TGridDrawInfo;
      OldLeft: integer;
  begin
     OldLeft:= Left;  // In case control's left is changed by grid
     if (Grid<>nil) and (not wwIsClass(Grid.classtype, 'TwwDBGrid')) then
        Grid.Update;
     with ParentGrid do begin
       BeginUpdate;
       CalcDrawInfo(DrawInfo);
       TDrawGrid(ParentGrid).row:= val;
       // Fix case where inherited grid gets confused on fixed columns
       if LeftCol<DrawInfo.Horz.FixedCellCount then
       begin
         LeftCol:= DrawInfo.Horz.FixedCellCount;
       end;
       EndUpdate;
       Invalidate;
     end;
     Left:= OldLeft;
  end;

begin
   if InRefreshCalcField then exit;  // Don't collapse if refreshing
   if InClickEvent then exit;
   if Grid=nil then exit;
//      screen.cursor:= crarrow;

   inherited Click;
   if not (parent is TCustomGrid) then exit;
   if Grid=nil then exit;

   SkipSetTop:= False;

   parentGrid:= TwwDBgrid(parent);
   DefaultRowHeight:= TDrawGrid(parentGrid).DefaultRowHeight;
   OrigDesiredRow:= DesiredRow;

   // Check if gird has any expandbuttons.  If so, then
   // we don't allow shrinkage as we need to accomodate embedded grid.
   TerminalNode:= True;
   for i:= 0 to Grid.ControlCount-1 do
      if Grid.Controls[i] is TwwExpandButton then TerminalNode:= False;
//   TempAutoShrink:= AutoShrink;

   InClickEvent:= True;

  try
   if checked then begin
      BeforeExpandHeightOfParentGrid:= 0;
      if OriginalHeight=0 then
         OriginalHeight:= Grid.Height;

      if (Grid is TwwDBGrid) then with TwwDBGrid(Grid) do
      begin
//         if TerminalNode and (AutoShrink = easTerminalGrid) or
//            (AutoShrink = easAllGrids) then
         Grid.parent:= self.parent;  // Set parent now so RowHeights are accurate

         if {TerminalNode and }AutoShrink then
         begin
           ClearHorzRange;  // So UpdateRowCount works accurately
           Height:= OriginalHeight;
           UpdateRowCount;
//           OldRowCount:= GetRowCount;
           DoShrinkToFit;
//           if GetRowCount<OldRowCount then
//              SetScrollRange(Handle, SB_VERT, 0, 0, False);
//         UpdateRowCount;
//         Height:= Height;
         end
      end
      else Grid.parent:= self.parent;  // Set parent now so RowHeights are accurate

//! increase parentgrid height if its also a childgrid
// Not easily done, as then we need to recompute parent's rowoffset
// Instead let us just allow AutoShrink only for terminal nodes
      with parentGrid do begin
//        SpaceAvailable:= ClientHeight - CellRect(0, TDrawGrid(parentGrid).Row).Bottom;
        // 10/10/01 - Use Leftcol instead of 0 in case indicator column is not visible
        SpaceAvailable:= ClientHeight - CellRect(LeftCol, TDrawGrid(parentGrid).Row).Bottom;
        if TerminalNode then
          SpaceNeeded:= Grid.height-1-SpaceAvailable
        else
          SpaceNeeded:= OriginalHeight-1-SpaceAvailable;
        if SpaceNeeded>0 then
        begin
           if ParentGrid.haveanyrowlines then
               ShiftAmount:= SpaceNeeded div (DefaultRowHeight+1) + 1
           else
               ShiftAmount:= SpaceNeeded div (DefaultRowHeight) + 1
        end
        else ShiftAmount:=0;

        if (ParentGrid is TwwDBGrid) then
        begin
            // Compute desired row based on having enough
            // space to display the entire original grid
            // Note: Make desired row smaller, never make larger
            if (dgTitles in Options) and (AutoShrink) and (not TerminalNode) then
            begin
               TempDesiredRow:=
                  (ClientHeight - (OriginalHeight + self.Height + 1) - (RowHeights[0]+2{+Grid.GetEffectiveFooterHeight})) div DefaultRowHeight+ 1;
               if DesiredRow=-1 then
               begin
                  DesiredRow:= wwmin(TempDesiredRow, TDrawGrid(parentGrid).Row - ShiftAmount);
               end
               else DesiredRow:= wwmin(DesiredRow, TempdesiredRow);
            end
        end;
        if (DesiredRow>=0) and (ShiftAmount>0) then
        begin
           // Update desired row based on new shift amount
           // Never m