dbccbox.pas

DELPHI编写的商场收银POS机源代码

begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
      end;
  end;
end;

procedure TDBCodeComboBox.EditingChange(Sender: TObject);
begin
  SetEditReadOnly;
end;

procedure TDBCodeComboBox.SetEditReadOnly;
begin
  if (Style in [csDropDown, csSimple]) and HandleAllocated then
    SendMessage(EditHandle, EM_SETREADONLY, Ord(not FDataLink.Editing), 0);
end;

procedure TDBCodeComboBox.WndProc(var Message: TMessage);
begin
  if not (csDesigning in ComponentState) then
    case Message.Msg of
      WM_COMMAND:
        if TWMCommand(Message).NotifyCode = CBN_SELCHANGE then
          if not FDataLink.Edit then
          begin
            if Style <> csSimple then
              PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
            Exit;
          end;
      CB_SHOWDROPDOWN:
        if Message.WParam <> 0 then FDataLink.Edit else
          if not FDataLink.Editing then DataChange(Self); {Restore text}
      WM_CREATE,
      WM_WINDOWPOSCHANGED,
      CM_FONTCHANGED:
        FPaintControl.DestroyHandle;
    end;
  inherited WndProc(Message);
end;

procedure TDBCodeComboBox.ComboWndProc(var Message: TMessage; ComboWnd: HWnd;
  ComboProc: Pointer);
begin
  if not (csDesigning in ComponentState) then
    case Message.Msg of
      WM_LBUTTONDOWN:
        if (Style = csSimple) and (ComboWnd <> EditHandle) then
          if not FDataLink.Edit then Exit;
    end;
  inherited ComboWndProc(Message, ComboWnd, ComboProc);
end;

procedure TDBCodeComboBox.CMEnter(var Message: TCMEnter);
begin
  inherited;
  if SysLocale.FarEast and FDataLink.CanModify then
    SendMessage(EditHandle, EM_SETREADONLY, Ord(False), 0);
end;

procedure TDBCodeComboBox.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TDBCodeComboBox.WMPaint(var Message: TWMPaint);
var
  S: string;
  R: TRect;
  P: TPoint;
  Child: HWND;
begin
  if csPaintCopy in ControlState then
  begin
    if FDataLink.Field <> nil then S := FDataLink.Field.Text else S := '';
    if Style = csDropDown then
    begin
      SendMessage(FPaintControl.Handle, WM_SETTEXT, 0, Longint(PChar(S)));
      SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
      Child := GetWindow(FPaintControl.Handle, GW_CHILD);
      if Child <> 0 then
      begin
        Windows.GetClientRect(Child, R);
        Windows.MapWindowPoints(Child, FPaintControl.Handle, R.TopLeft, 2);
        GetWindowOrgEx(Message.DC, P);
        SetWindowOrgEx(Message.DC, P.X - R.Left, P.Y - R.Top, nil);
        IntersectClipRect(Message.DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top);
        SendMessage(Child, WM_PAINT, Message.DC, 0);
      end;
    end else
    begin
      SendMessage(FPaintControl.Handle, CB_RESETCONTENT, 0, 0);
      if Items.IndexOf(S) <> -1 then
      begin
        SendMessage(FPaintControl.Handle, CB_ADDSTRING, 0, Longint(PChar(S)));
        SendMessage(FPaintControl.Handle, CB_SETCURSEL, 0, 0);
      end;
      SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
    end;
  end else
    inherited;
end;

procedure TDBCodeComboBox.SetItems(Value: TStrings);
begin
  Items.Assign(Value);
  DataChange(Self);
end;

procedure TDBCodeComboBox.SetStyle(Value: TComboboxStyle);
begin
  if (Value = csSimple) and Assigned(FDatalink) and FDatalink.DatasourceFixed then
    //DatabaseError(SNotReplicatable);
    ;
  inherited SetStyle(Value);
end;

function TDBCodeComboBox.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

procedure TDBCodeComboBox.CMGetDatalink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

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

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

procedure TDBCodeComboBox.SetDisplayDatasource(const Value: TDataSource);
begin
  if (Value <> FDisplayDatasource) then
  begin
    FDisplayDatasource := Value;
  end;
end;

procedure TDBCodeComboBox.SetCodeField(const Value: string);
begin
  if (Value <> FCodeField) then
  begin
    FCodeField := Value;
  end;
end;

procedure TDBCodeComboBox.SetDisplayField(const Value: string);
begin
  if (Value <> FDisplayField) then
  begin
    FDisplayField := Value;

    if (assigned(Field)) then
    begin
      if (Assigned(DisplayDatasource)) then
      begin
        SetupQueryProperties;
        ConstructSQL;
        FillComboBoxItems;
        ItemIndex := 0;        
      end;
    end
  end;
end;

//=============================自定义函数开始=============================
procedure TDBCodeComboBox.SetupQueryProperties;
begin
  if Assigned(Field) then
    FQuery.DatabaseName := TDBDataSet(Field.DataSet).DatabaseName;
end;

procedure TDBCodeComboBox.ConstructSQL;
var
  iPos : Integer;
  FOldSQL : string;
  FTableName : string;
begin
  if (Assigned(FDisplayDatasource) and Assigned(FDisplayDatasource.DataSet) ) then
  begin
    FQuery.Active := False;

    FSQL := 'select ' + FCodeField + ',' + FDisplayField + ' from ';
    FTableName := '';

    if (FDisplayDatasource.DataSet is TTable) then
    begin
      FSQL := FSQL + TTable(FDisplayDatasource.DataSet).TableName;
    end
    else
    begin
      FOldSQL := UpperCase(TQuery(FDisplayDatasource.DataSet).SQL.Text);
      iPos := Pos('FROM', FOldSQL);
      if (iPos > 0) then
      begin
        while (FOldSQL[iPos] <> ' ') do
          Inc(iPos);

        Inc(iPos);
        while ( (FOldSQL[iPos] <> ' ') and (iPos < Length(FOLDSQL)) ) do
        begin
          FTableName := FTableName + FOldSQL[iPos];
          Inc(iPos);
        end;

        FSQL := FSQL + FTableName;
      end;
    end;

    FQuery.SQL.Clear;
    FQuery.SQL.Add(FSQL);
    FQuery.Active := True;
  end;
end;

procedure TDBCodeComboBox.FillComboBoxItems;
begin
  if (FQuery.Active) then
  begin
    Items.Clear;
    While (not FQuery.EOF) do
    begin
      Items.Add(FQuery.Fields[1].Value);
      FQuery.Next;
    end;
  end;
end;

function TDBCodeComboBox.GetDisplayValue(const sText : string) : string;
begin
  try
    if (not FQuery.Active) then
    begin
      try
        SetupQueryProperties;
        ConstructSQL;
        FillComboBoxItems;
      except
        on Exception do;
      end;
    end;

    Result := '';
    if (FQuery.Active) then
      if FQuery.Locate(FCodeField, sText, []) then
      begin
        Result := FQuery.FieldByName(FDisplayField).Value;
      end;
  except
    On Exception do;
  end;
end;

function TDBCodeComboBox.GetCodeValue(const sText : string) : string;
begin
  try
    if (not FQuery.Active) then
    begin
      SetupQueryProperties;
      ConstructSQL;
      FillComboBoxItems;
    end;

    Result := '';
    if (FQuery.Active) then
      if FQuery.Locate(FDisplayField, sText, []) then
      begin
        Result := FQuery.FieldByName(FCodeField).Value;
      end;
  except
    On Exception do;
  end;
end;

//自定义函数结束

end.