⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wwdbigrdtest.pas

📁 InfoPower_Studio 2007 v5.0.1.3 banben
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    begin
       tc:= screen.activecontrol;
       if not (tc is TwwCustomDBGrid) then
       begin
          repeat
             tc:= tc.parent;
          until (tc=nil) or (tc is TwwCustomDBGrid);
       end;
       result:=  (tc is TwwCustomDBGrid);
       if result then
          Grid:= TwwCustomDBGrid(tc)
       else
          Grid:=nil;
    end;

    Function IsChildOfGrid(var Inspector: TwwCustomDBGrid): boolean;
    var tc: TWinControl;
        grid: TwwCustomDBGrid;
    begin
       GetwwDBGrid(Grid);
       if (Grid=Nil) or Grid.IsDropDownGridFocused then begin
          result:= False;
          exit;
       end;
       tc:= screen.activecontrol;
       if not (tc is TCustomGrid) then
       begin
          repeat
             tc:= tc.parent;
          until (tc=nil) or (tc is TCustomGrid);
       end;
       result:=  (tc is TCustomGrid);
       if result and wwIsClass(tc.classtype, 'TwwCustomDBGrid') then
          Inspector:= TwwCustomDBGrid(tc)
       else begin
          Inspector:=nil;
          result:= false;
       end
    end;

  function Selection: TSelection;
  begin
    SendMessage(ac.Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  end;


  function RightSide: Boolean;
  begin
    with ac do
      with Selection do
        Result := ((StartPos = 0) or (EndPos = StartPos)) and
          (EndPos = GetTextLen);
  end;

  function LeftSide: Boolean;
  begin
    with ac do
      with Selection do
        Result := (StartPos = 0) and
        ((EndPos = 0) or (EndPos = GetTextLen) {or (isMasked and (EndPos=1))});
    if ac is TwwDBCustomEdit then with TwwDBCustomEdit(ac) do
       if isMasked and (Selection.EndPos=1) then result:= True;
  end;

  function TrueFocusIsGrid: boolean;
  begin
     result:= IsChild(Grid.Handle, GetFocus) or (GetFocus=Grid.Handle);
  end;

begin
    ac:= screen.activecontrol;
    if ac is TCustomGrid then  // inplaceeditor doesn't update ac
    begin
       if (TwwCustomDBGrid(ac).inplaceeditor<>nil) and
          (TwwCustomDBGrid(ac).inplaceeditor.handle = GetFocus) then
       begin
          ac:= TwwCustomDBGrid(ac).inplaceeditor;
       end
    end;

    result := CallNextHookEx(KeyHook, nCode, wParam, lParam);
    if ac=nil then exit;

    if ((wparam = 13) or (wparam = 9)) and
       not (GetKeyState(vk_control)<0) and
       not (GetKeyState(vk_menu)<0) and
       (GetFocus=ac.handle) then
    begin
       if (lparam and $80000000)=0 then begin
         if IsChildOfGrid(Grid) then
         begin
           if (dgEnterToTab in Grid.KeyOptions) or (wparam=vk_tab) then
           begin
//             Inspector.SetFocus;
//             PostMessage(Grid.handle, WM_KEYDOWN, VK_TAB, 0);
             PostMessage(Grid.handle, WM_KEYDOWN, wparam, 0);
             result:=1;
           end
         end
       end
       // 6/20/01
       else if not IsChildOfGrid(Grid) then // Another form is active
          result:=0
       else result:=1
    end
{    else if (wparam = vk_f2) and
       not (GetKeyState(vk_control)<0) and
       not (GetKeyState(vk_menu)<0) then
    begin
       if IsChildOfInspector(Inspector) then
       begin
         if (lparam and $80000000)=0 then
           Inspector.FCustomControlKeyMode:= not Inspector.FCustomControlKeyMode;
       end
    end}
    // Collapse expand button on Ctrl-left
    else if (wparam in [vk_left]) and
        ((lparam and $80000000)=0) and
        (GetKeyState(vk_control)<0) and
        GetwwDBgrid(Grid) and Grid.IsDropDownGridFocused then begin
       Grid.CollapseChildGrid
    end
    // Need obj property to see if we should pass vk_down, vk_up, vk_next, and vk_prior to inspector
    // Always pass vk_left, vk_right
    else if (wparam in [vk_home, vk_end, vk_right, vk_left, vk_down, vk_up, vk_next, vk_prior,
                        vk_delete]) and
        ((lparam and $80000000)=0) and
        (GetKeyState(vk_control)<0) then
    begin
        // So dropped-down combos get keystrokes, check if radio-group is still ok
        if wwHaveVisibleChild(ac) then exit;

        if IsChildOfGrid(Grid) and (ac<>Grid)  then
        begin
           PostMessage(Grid.handle, WM_KEYDOWN, wparam, 0);
           result:=1;
        end
    end
    else if (wparam in [vk_left, vk_right, vk_down, vk_up, vk_next, vk_prior,
       vk_insert]) and
       not (GetKeyState(vk_control)<0) and
       not (GetKeyState(vk_menu)<0) then
    begin
       if wwHaveVisibleChild(ac) then exit;

       if (lparam and $80000000)=0 then begin
         // Immediate child used to support radiogroup in TwwDBGrid
//         if IsChildOfGrid(Inspector) and // Initialize inspector
//            IsImmediateChildOfGrid and (ac<>Inspector) then
         if IsChildOfGrid(Grid) then
         begin
            if not TrueFocusIsGrid then exit;
            if not IsImmediateChildOfGrid and (ac<>Grid) then
            begin
               if (wparam in [vk_left, vk_right, vk_up, vk_down]) then exit; // radiogroup item has focus
            end;

            // Send to inspector navigation keys
            if (ac is TCustomEdit) then
            begin
               case wparam of
                 VK_LEFT: if not LeftSide then exit;
                 VK_RIGHT: if not RightSide then exit;
               end
            end;

            if Grid.Focused then exit
            else begin
               PostMessage(Grid.handle, WM_KEYDOWN, wparam, 0);
            end;

            result:=1;
         end
       end
       // 6/20/01
       else if not IsChildOfGrid(Grid) then // Another form is active
          result:=0
       else result:=1
    end

end;

procedure TwwGridHintWindow.Paint;
var
  R: TRect;
  WriteOptions: TwwWriteTextOptions;
begin
  R := ClientRect;
  Inc(R.Left, 1);
  Inc(R.Top, 2);
  Canvas.Font.Color := clInfoText;
  if WordWrap then
     WriteOptions:= [wtoWordWrap];
//  if (Field<>nil) and
//      TwwCustomDBGrid(Owner).UseRightToLeftAlignmentForField(Field, Alignment) then
//     WriteOptions:= WriteOptions + [wtoRightToLeft];

  wwWriteTextLinesT(Canvas, R, 0, 0, PChar(Caption), Alignment,
    WriteOptions);
//  SetBkMode(Canvas.Handle, TRANSPARENT);
//  DrawText(Canvas.Handle, PChar(Caption), -1, R,
//     DT_LEFT or DT_NOPREFIX {or DT_WORDBREAK });
end;


function TwwCustomDBGrid.UseAlternateBuffering: boolean;
begin
   result:= AlternatePaintBuffering or
      UseRightToLeftAlignment
end;

function TwwCustomDBGrid.GetCanvas: TCanvas;
begin
  if useDragCanvas then
     result:= CaptureTitleBitmap.Canvas
  else if not UseAlternateBuffering then
     result:= FPaintCanvas
  else
     result:= inherited Canvas;
//     result:= inherited Canvas;
end;

procedure UpdateSelectedProp(Selected: TStrings;
   FieldName: string; val: string;
   SelectedProperty: TwwUpdateSelected; Index: integer = -1);
var APos: integer;
    FieldWidth, DisplayLabel, ReadOnly, GroupName: wwSmallString;
begin
   if Index=-1 then
   begin
      if not wwFindSelected(Selected, FieldName, index) then exit;
   end;

   begin
      APos:=1;
      FieldName:= strGetToken(Selected[index], #9, apos);
      FieldWidth:= strGetToken(Selected[index], #9, apos);
      DisplayLabel:= strGetToken(Selected[index], #9, apos);
      ReadOnly:= strGetToken(Selected[index], #9, apos);
      if ReadOnly='' then ReadOnly:= 'F';
      GroupName:= strGetToken(Selected[index], #9, apos);
      case SelectedProperty of
         sptUpdateGroup: GroupName:= val;
         sptUpdateWidth: FieldWidth:= val;
         sptUpdateLabel: DisplayLabel:= val;
         sptUpdateReadOnly: ReadOnly:= val;
      end;
      Selected[index]:= FieldName + #9 + FieldWidth + #9 +
         DisplayLabel + #9 + ReadOnly;
      if GroupName<>'' then
         Selected[index]:= Selected[index] + #9 + GroupName;
   end;
end;

function GetSelectedProp(Selected: TStrings;
   FieldName: string;
   SelectedProperty: TwwUpdateSelected): string;
var APos, index: integer;
    FieldWidth, DisplayLabel, ReadOnly, GroupName: wwSmallString;
begin
   if wwFindSelected(Selected, FieldName, index) then
   begin
      APos:=1;
      FieldName:= strGetToken(Selected[index], #9, apos);
      FieldWidth:= strGetToken(Selected[index], #9, apos);
      DisplayLabel:= strGetToken(Selected[index], #9, apos);
      ReadOnly:= strGetToken(Selected[index], #9, apos);
      if ReadOnly='' then ReadOnly:= 'F';
      GroupName:= strGetToken(Selected[index], #9, apos);
      case SelectedProperty of
         sptUpdateGroup: result:= GroupName;
         sptUpdateField: result:= FieldName;
         sptUpdateWidth: result:= FieldWidth;
         sptUpdateLabel: result:= DisplayLabel;
         sptUpdateReadOnly: result:= ReadOnly;
      end;
   end
end;

Function min(x,y: integer): integer;
begin
   if x<y then min:= x
   else min:= y;
end;

{ Error reporting }
procedure RaiseGridError(const S: string);
begin
  raise EInvalidGridOperation.Create(S);
end;

{procedure GridError(S: Word);
begin
  RaiseGridError(LoadStr(S));
end;

procedure GridErrorFmt(S: Word; const Args: array of const);
begin
  RaiseGridError(FmtLoadStr(S, Args));
end;
}

{ TwwGridDataLink }
type
  TIntArray = array[0..MaxMapSize] of Integer;
  PIntArray = ^TIntArray;

  TBitmapCacheType=class
    Bitmap: TBitmap;
    LookupValue: string;
    curField: TField;
  end;

constructor TwwGridDataLink.Create(AGrid: TwwCustomDBGrid);
begin
  inherited Create;
  FGrid := AGrid;
  VisualControl:= True;
end;

destructor TwwGridDataLink.Destroy;
begin
  ClearMapping;
  inherited Destroy;
end;

function TwwGridDataLink.GetDefaultFields: Boolean;
begin
  Result := True;
  if DataSet <> nil then Result := DataSet.DefaultFields;
end;

function TwwGridDataLink.GetFields(I: Integer): TField;
begin
  if I < FFieldCount then
    Result := DataSet.Fields[PIntArray(FFieldMap)^[I]]
  else Result:= nil;
end;

function TwwGridDataLink.AddMapping(const FieldName: string): Boolean;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -