wwdbcomb.pas

InfoPower_Studio 2007 v5.0.1.3 banben

    CloseUp(PtInRect(FListBox.ClientRect, Point(X, Y)));
end;

procedure TwwDBCustomComboBox.CNKeyDown(var Message: TWMKeyDown);
begin
  if not (csDesigning in ComponentState) then
    with Message do
    begin
       if (charcode = VK_TAB) and FListVisible then Closeup(True)
       else if FListVisible and
        ((charcode=vk_return) or (charcode=vk_escape)) then
         exit;
    end;

  inherited;
end;

procedure TwwDBCustomComboBox.KeyUp(var Key: Word; Shift: TShiftState);
begin
   if AllowClearKey then begin
      if FListVisible then begin
         if ((key=vk_delete) or (key=vk_back)) and (Text='') then
            itemIndex:= -1
      end
      else begin
         if ((key=vk_delete) or (key=vk_back)) and
             (Style=csDropDownList) and (not ShowMatchText) then
         begin
            EnableEdit; {7/30/97 - Enable edit }
            Text:= '';
            itemIndex:= -1;  { 8/22/96}
            SetModified(True);  {11/18/97}
         end
      end;
   end;

   inherited KeyUp(Key, Shift);
end;

procedure TwwPopupListbox.WMKeyDown(var Message: TWMKeyDown);
begin
   // Allow combo's text to change when scrolling
   if message.charcode in [vk_next, vk_prior, vk_up, vk_down] then
     (parent as TwwDBCustomComboBox).doSelchange:= true;
   inherited;
   (parent as TwwDBCustomComboBox).doSelchange:= False;
end;
{procedure TwwPopupListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
   if key in [vk_next, vk_prior, vk_up, vk_down] then
     (parent as TwwDBCustomComboBox).doSelchange:= true;
   inherited;
   (parent as TwwDBCustomComboBox).doSelchange:= False;
end;
}
{ Support scrolling vai VK_Up and VK_Down when listbox is not shown. }
procedure TwwDBCustomComboBox.KeyDown(var Key: Word; Shift: TShiftState);
var curpos: integer;
//    tempIndex: integer;
//    Litem:string;

    procedure SelectValue(AIndex: integer);
    begin
       ListBoxItemsNeeded;
       if AIndex>FListBox.Items.count-1 then exit;
       if AIndex<0 then exit;
       if (Datasource<>nil) then begin
          DataLink.Edit;
          if not DataLink.Editing then begin
            if (DataLink.Field<>nil) and (DataLink.Field.Calculated) and EditCanModify then
               DataLink.DataSet.Edit
            else exit; { 4/2/99 - Support calculated field edits}
          end
       end;
       curpos:= 1;
       SetItemIndex(AIndex);  { 9/24/97 - Call SetItemIndex instead of setting FItemIndex }
{       FItemIndex:= AIndex;
       Text:= strGetToken(FItems[AIndex], #9, curPos);}
       SetModified(True);  {5/17/97}
       DoSelectAll;
    end;

    procedure ClearValue;
    begin
       if Text<>'' then
       if (Datasource<>nil) then begin
          DataLink.Edit;
          if not DataLink.Editing then begin
            if (DataLink.Field<>nil) and (DataLink.Field.Calculated) and EditCanModify then
               DataLink.DataSet.Edit
            else exit; { 4/2/99 - Support calculated field edits}
          end
       end;
       SetItemIndex(-1);
       SetModified(True);
    end;

    function IsCtrlX: boolean;
    begin
       result:= (key=ord('X')) and (ssCtrl in Shift)
    end;

begin
   if (Key = VK_RETURN) and FHistoryList.Enabled then AddItem(Text, True);

   if (not DroppedDown) and wwIsValidChar(Key) and AutoDropDown and
      (not (key in [VK_DELETE,VK_BACK])) and
      not (ssAlt in Shift) then begin { 9/25/97 - Don't auto-drop down if alt key is pressed }
      InAutoDropDown:= True;
      DropDown;
      InAutoDropDown:= False;
   end;

   if GetKeyState(VK_MENU) < 0 then
   begin
      Include(Shift, ssAlt);
   end;

   { 3/31/99 - Improved support for ShowMatchText and AllowClearKey }
   if ShowMatchText and
      ((key=vk_delete) or (key=vk_back) or IsCtrlX) and (Style=csDropDownList) then
   begin
      if (AllowClearKey) and (selText=Text) then
      begin
         if (DataLink.Field=Nil) and (inherited ReadOnly) then // 2/22/02 - do nothing if unbound and readonly
         else ClearValue;
         key:= 0;
      end
      else begin
{         if (selStart>0) then
         begin
            SendMessage(Handle, EM_SETSEL, length(Text), selStart-1);
            SendMessage(Handle, EM_SCROLLCARET, 0,0);
         end; }
         key:= 0;
      end;
   end
   else if (not (FListVisible)) then
   begin
      if (not (parent is TCustomGrid)) and { 6/22/99 - Support TwwObjectView }
         ((Key=VK_Down) or (Key=vk_Up)) then
      begin
         if (DataLink.Field=Nil) and (inherited ReadOnly) then // 2/22/02 - do nothing if unbound and readonly
         else begin
           if key=vk_down then SelectValue(FItemIndex + 1)
           else SelectValue(FItemIndex-1);
         end;
         if Assigned(OnKeyDown) then OnKeyDown(Self, Key, Shift);  { 9/5/00 - Fire onkeydown event }
         Key:= 0;
         exit;
      end
      else if ShowMatchText then
(*      else if not Editable {(Style=csDropDownList)} and wwIsValidChar(Key) then begin  { Use first character to search }
         if not (ssAlt in Shift) then { 9/25/97 - Don't search if alt key is pressed }
         for i:= FItemIndex+1 to (FItemIndex + FItems.count) do begin
            tempIndex:= i mod (FItems.count);
            curpos:= 1;
            Litem:=uppercase(strGetToken(FItems[tempIndex],#9, curPos));
            if (key >= VK_NUMPAD0) and (key <= VK_NUMPAD9) then  {1/16/98- Handle Numpad keys}
            begin
               if pos(uppercase(char(key-ord('0'))),Litem)=1 then begin
                  SelectValue(tempIndex);
                  break;
               end
            end
            else if pos(uppercase(char(key)),Litem)=1 then begin
               SelectValue(tempIndex);
               break;
            end
         end;
      end
*)
   end
   else begin
      if FListVisible and
         ((Style<>csDropDown) or AutoDropDown or   { 9/12/96 - Added "or AutoDropDown" }
         ((Style=csDropDown) and False and (selLength=length(Text)))) and  { 9/24/96 - Clear if all selected }
         wwIsValidChar(Key) and FNoKeysEnteredYet then
      begin
         EnableEdit; {7/23/97 - Enable edit so later call to edit will not revert text to original value}
//         Text:= '';  { 8/21/00 - Obsolete with new style enhancements - causes bug if left here now }
         FNoKeysEnteredYet:= False;
      end
   end;
   inherited KeyDown(Key, Shift);
end;

Function TwwDBCustomComboBox.Editable: boolean;
begin
   if OwnerDraw then result:= False
   else Result := (FStyle <> csDropDownList) {or isDroppedDown }or ShowMatchText;
end;

Function TwwDBCustomComboBox.MouseEditable: boolean;
begin
   if OwnerDraw then result:= False
   else Result := (FStyle <> csDropDownList);
end;

Procedure TwwDBCustomComboBox.ShowText(ACanvas: TCanvas;
          ARect: TRect; indentLeft, indentTop: integer; AText: string; transparent: boolean = false);
begin
   FCanvas:= ACanvas;
   if Assigned(FOnDrawItem) and OwnerDraw then
   begin
      if isDroppedDown then begin
         FCanvas.Brush.Color:= Color;
         FCanvas.Font.Color:= Font.Color;
      end;
      FCanvas.TextRect(ARect, ARect.Left, ARect.Top, '');
      try //10/29/01 - Handle the case when abort is called.
        FOnDrawItem(self, FItemIndex, ARect, [odFocused])
      except
      end;
   end
   else ACanvas.TextRect(ARect, indentLeft, indentTop, AText);
   FCanvas:= Nil;
end;

Function TwwDBCustomComboBox.OwnerDraw: boolean;
begin
   result:= Style in [csOwnerDrawFixed, csOwnerDrawVariable]
end;

Procedure TwwDBCustomComboBox.SetStyle(val: TComboBoxStyle);
begin
   if val=csSimple then ShowButton:= False
   else if (FStyle=csSimple) then ShowButton:= True;
   FStyle:= val;
end;

procedure TwwDBCustomComboBox.WMCut(var Message: TMessage);
begin
  if (Style=csDropDownList) and ShowMatchText and (not AllowClearKey) then
     message.result:=1
  else
     inherited;
end;

procedure TwwDBCustomComboBox.WMClear(var Message: TMessage);
begin
  if (Style=csDropDownList) and ShowMatchText and (not AllowClearKey) then
     message.result:=1
  else
     inherited;
end;


procedure TwwDBCustomComboBox.DeleteItem(Value: string; DeleteFromHistory: boolean = False);
var idx: integer;
begin
    if DeleteFromHistory then begin
       idx:= HistoryList.List.IndexOf(Value);
       if idx>=0 then HistoryList.List.Delete(idx);
    end;

    if (ListBox<>nil) and ListBox.HandleAllocated then begin
       idx:= Listbox.Items.IndexOf(Value);
       if idx>=0 then Items.Delete(idx);
       idx:= Listbox.Items.IndexOf(Value);  // do twice in case of mru
       if idx>=0 then Items.Delete(idx);
    end
end;

procedure TwwDBCustomComboBox.AddItem(Value: string; AddToHistory: boolean = False);
var idx: integer;
    accept: boolean;
begin
    strStripTrailing(Value, [' ', #9]);
//    ApplyMask;
    if Value='' then exit;

    idx:= HistoryList.List.IndexOf(Value); // 9/18/02 - Don't call addhistory event if already in list
    if (idx<0) and Assigned(FOnAddHistoryItem) then begin
       accept := True;
       FOnAddHistoryItem(Self, Value, accept);
       if accept = False then exit;
    end;

    if AddToHistory then begin
//       idx:= HistoryList.List.IndexOf(Value);
       if idx>=0 then HistoryList.List.delete(idx);  { By deleting keeps most recent at bottom of list }
       HistoryList.List.Add(Value);
    end;

    if (ListBox<>nil) and ListBox.HandleAllocated then begin
        if ListBox.Items.Indexof(Value)<0 then
           Listbox.Items.Add(Value);
    end;
end;

procedure TwwDBCustomComboBox.ClearHistory;
begin
   HistoryList.List.Clear;
   HistoryList.Save;
end;

procedure Register;
begin
{  RegisterComponents('InfoPower', [TwwDBComboBox]);}
end;

procedure TwwDBCustomComboBox.CMEnter(var Message: TCMEnter);
//var i: integer;
begin
   inherited;
   if HistoryList.Enabled then begin
      ApplyList;
//      HistoryList.Load(Listbox.Items);
   end;

{   with HistoryList do begin
      if List.Count>2 then
      begin
        for i := List.Count-2 to List.Count - 1 do
          Listbox.Items.Insert(0, List[i]);
      end
   end;}
end;

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

Function TwwDBCustomComboBox.IndexOf(Value: string; StartIndex: integer = 0) : integer;
var i, tempIndex: integer;
begin
   // 2/23/02 - Use FItems if listbox not yet created
   if (Listbox=nil) or (not Listbox.HandleAllocated) or
      (ListBox.Items.Count=0) then
      result:= FItems.Indexof(Value)
   else if startIndex=0 then
      result:= ListBox.Items.IndexOf(Value)
   else begin
       result:= -1;
       for i:= startIndex to (startIndex + ListBox.Items.count-1) do begin
          tempIndex:= i mod (ListBox.Items.count);
          if wwEqualStr(ListBox.Items[tempIndex], Value) then
          begin
             result:= tempIndex;
             break;
          end
       end;
   end
end;

// 11/29/01 - Don't paste into control with csDropDownList
procedure TwwDBCustomComboBox.WMPaste(var Message: TMessage);
begin
  if Style=csDropDownList then
    exit
  else
    inherited;
end;

procedure TwwDBCustomComboBox.Reset;

  function FindItemIndex : integer;
  var i,j,curpos: integer;
      NewText: string;
  begin
    if (Text = '') and (not MapList) then I := -1
    else begin
          i:= -1;
          for j:= 0 to FItems.count-1 do begin
             curpos:= 1;
             NewText:= strGetToken(FItems[j], #9, curPos);
             if NewText=Text then
             begin
                i:= IndexOf(NewText);
                break;
             end
          end;
    end;
    result:= i;

  end;


begin
  Patch[5]:= True;
  Try
    inherited Reset;
  finally
    Patch[5]:= False;
  end;
  if DataLink.Field=Nil then begin
     FItemIndex:= FindItemIndex;
  end;
end;

end.